diff --git a/.gitignore b/.gitignore index 01b8f29b54..0b3138728d 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,19 @@ *~ html *.log +MOM6 +build/ +deps/ +#.testing/*/available_diags.* +#.testing/*/CPU_stats +#.testing/*/chksum_diag +#.testing/*/exitcode +#.testing/*/logfile.*.out +#.testing/*/MOM_parameter_doc.* +#.testing/*/ocean_geometry.nc +#.testing/*/ocean.stats +#.testing/*/ocean.stats.nc +#.testing/*/RESTART/ +#.testing/*/time_stamp.out +#.testing/*/Vertical_coordinate.nc +#.testing/*/GOLD_IC.nc diff --git a/.testing/.gitignore b/.testing/.gitignore new file mode 100644 index 0000000000..f119a40591 --- /dev/null +++ b/.testing/.gitignore @@ -0,0 +1,13 @@ +available_diags.* +CPU_stats +chksum_diag +exitcode +logfile.*.out +MOM_parameter_doc.* +ocean_geometry.nc +ocean.stats +ocean.stats.nc +RESTART/ +time_stamp.out +Vertical_coordinate.nc +GOLD_IC.nc diff --git a/.testing/Makefile b/.testing/Makefile index ee561375a3..1dee0e2100 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -1,77 +1,288 @@ -# Makefile steps to run on Travis-CI -# e.g. make MEMORY_SHAPE=dynamic_symmetric REPRO=1 OPENMP=1 +SHELL = bash +MPIRUN ?= mpirun + +-include config.mk + +#--- +# Dependencies +BASE = $(dir $(abspath $(lastword $(MAKEFILE_LIST))))/.. +DEPS = $(BASE)/deps +BUILD = $(BASE)/build -# Versions to use -FMS_COMMIT ?= xanadu +# mkmf, list_paths (GFDL build toolchain) +MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git MKMF_COMMIT ?= master +LIST_PATHS := $(abspath $(DEPS)/mkmf/bin/list_paths) +MKMF := $(abspath $(DEPS)/mkmf/bin/mkmf) -# Where to clone from +# FMS framework FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git -MKMF_URL ?= https://github.com/NOAA-GFDL/mkmf.git -CONFIGS_URL ?= https://github.com/NOAA-GFDL/MOM6-examples.git -REGRESSIONS_URL ?= https://github.com/adcroft/Gaea-stats-MOM6-examples +FMS_COMMIT ?= f2e2c86f6c0eb6d389a20509a8a60fa22924e16b +FMS := $(DEPS)/fms + +#--- +# Build configuration + +# Build settings +MKMF_CPP = "-Duse_libMPI -Duse_netCDF -DSPMD" + +# Environment +# TODO: This info ought to be determined by CMake, automake, etc. +#MKMF_TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk +MKMF_TEMPLATE ?= $(DEPS)/mkmf/templates/ncrc-gnu.mk +#MKMF_TEMPLATE ?= $(DEPS)/mkmf/templates/ncrc-intel.mk + +#--- +# Test configuration + +# Executables +BUILDS = symmetric asymmetric repro +CONFIGS := $(foreach n,$(shell seq 0 3),tc$(n)) +TESTS = grids layouts restarts repros nans dims + +# The following variables are configured by Travis: +# DO_REGRESSION_TESTS: true if $(TRAVIS_PULL_REQUEST) is a PR number +# MOM_TARGET_SLUG: TRAVIS_REPO_SLUG +# MOM_TARGET_LOCAL_BRANCH: TRAVIS_BRANCH +# +# These are set to true by Travis if testing a pull request +DO_REGRESSION_TESTS ?= +REPORT_COVERAGE ?= + +ifeq ($(DO_REGRESSION_TESTS), true) + BUILDS += target + TEST += regressions + + MOM_TARGET_SLUG ?= NOAA-GFDL/MOM6 + MOM_TARGET_URL ?= https://github.com/$(MOM_TARGET_SLUG) -# Experiments to run -ifeq ($(MEMORY_SHAPE),"dynamic_symmetric") -EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL circle_obcs + MOM_TARGET_LOCAL_BRANCH ?= dev/gfdl + MOM_TARGET_BRANCH := origin/$(MOM_TARGET_LOCAL_BRANCH) + + TARGET_CODEBASE = $(BUILD)/target_codebase else -EXPERIMENTS ?= unit_tests double_gyre flow_downslope/z CVmix_SCM_tests/cooling_only/EPBL + MOM_TARGET_URL = + MOM_TARGET_BRANCH = + TARGET_CODEBASE = endif -FMS_PACKAGES ?= platform,include,memutils,constants,mpp,fms,time_manager,diag_manager,data_override,coupler/coupler_types.F90,coupler/ensemble_manager.F90,axis_utils,horiz_interp,time_interp,astronomy,mosaic,random_numbers -TEMPLATE ?= .testing/linux-ubuntu-xenial-gnu.mk -MPIRUN ?= mpirun -# MEMORY_SHAPE must be defined for this Makefile to work -MEMORY_SHAPE ?= dynamic_symmetric +#--- +# Rules -# Everything above is above is "configurable" with environment variables -SHELL = bash +.PHONY: all +all: $(foreach b,$(BUILDS),$(BUILD)/$(b)/MOM6) + +# Executable +BUILD_TARGETS = MOM6 Makefile path_names +.PRECIOUS: $(foreach b,$(BUILDS),$(foreach f,$(BUILD_TARGETS),$(BUILD)/$(b)/$(f))) -# Path where executable will be built -BUILD_PATH = build -###/$(MEMORY_SHAPE)-$(EXEC_MODE) -# Root of configurations (MOM6-examples) -EXPERIMENTS_ROOT = experiments -# Regression results -REGRESSIONS_ROOT = answers +# Conditionally build symmetric with coverage support +COVFLAG=$(if $(REPORT_COVERAGE),COVERAGE=1,) -.PRECIOUS: %/ocean.stats +$(BUILD)/target/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 +$(BUILD)/symmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 $(COVFLAG) +$(BUILD)/asymmetric/MOM6: MOMFLAGS=NETCDF=3 DEBUG=1 +$(BUILD)/repro/MOM6: MOMFLAGS=NETCDF=3 REPRO=1 -run: $(foreach e,$(EXPERIMENTS),$(EXPERIMENTS_ROOT)/ocean_only/$(e)/ocean.stats) +$(BUILD)/asymmetric/path_names: GRID_SRC=config_src/dynamic +$(BUILD)/%/path_names: GRID_SRC=config_src/dynamic_symmetric -test: $(foreach e,$(EXPERIMENTS),$(REGRESSIONS_ROOT)/regressions/ocean_only/$(e)/ocean.stats.gnu) +$(BUILD)/%/MOM6: $(BUILD)/%/Makefile $(FMS)/lib/libfms.a + make -C $(@D) $(MOMFLAGS) $(@F) -compile: $(BUILD_PATH)/MOM6 +$(BUILD)/%/Makefile: $(BUILD)/%/path_names + cp $(MKMF_TEMPLATE) $(@D) + cd $(@D) && $(MKMF) \ + -t $(notdir $(MKMF_TEMPLATE)) \ + -o '-I $(FMS)/build' \ + -p MOM6 \ + -l '$(FMS)/lib/libfms.a' \ + -c $(MKMF_CPP) \ + path_names -$(BUILD_PATH)/MOM6: FMS mkmf +# NOTE: These path_names rules could be merged + +$(BUILD)/target/path_names: $(LIST_PATHS) $(TARGET_CODEBASE) mkdir -p $(@D) - cd $(@D); \ - ../mkmf/bin/list_paths -l ../FMS/{$(FMS_PACKAGES)} ../config_src/{$(MEMORY_SHAPE),solo_driver} ../src \ - && ../mkmf/bin/mkmf -t ../$(TEMPLATE) -c '-Duse_libMPI -Duse_netCDF -DSPMD -DUSE_LOG_DIAG_FIELD_INFO -DMAXFIELDMETHODS_=500' -p $(@F) path_names \ - && make -j NETCDF=3 $(@F) + cd $(@D) && $(LIST_PATHS) -l \ + $(TARGET_CODEBASE)/src \ + $(TARGET_CODEBASE)/config_src/solo_driver \ + $(TARGET_CODEBASE)/$(GRID_SRC) -$(EXPERIMENTS_ROOT)/%/ocean.stats: $(EXPERIMENTS_ROOT) - mkdir -p $(@D)/RESTART - cd $(@D) ; $(MPIRUN) -n 1 $(PWD)/$(BUILD_PATH)/MOM6 +$(BUILD)/%/path_names: $(LIST_PATHS) + mkdir -p $(@D) + cd $(@D) && $(LIST_PATHS) -l \ + $(BASE)/src \ + $(BASE)/config_src/solo_driver \ + $(BASE)/$(GRID_SRC) -$(REGRESSIONS_ROOT)/regressions/%/ocean.stats.gnu: $(EXPERIMENTS_ROOT)/%/ocean.stats $(REGRESSIONS_ROOT) - cp $< $@ - cd $(@D) ; git status --porcelain $(@F) +# Target repository for regression tests +$(TARGET_CODEBASE): + git clone --recursive $(MOM_TARGET_URL) $@ + cd $@ && git checkout $(MOM_TARGET_BRANCH) -# Targets to clone repositories needed to build -FMS: - git clone -q $(FMS_URL) - cd $@ ; git checkout -q $(FMS_COMMIT) -mkmf: - git clone -q $(MKMF_URL) - cd $@ ; git checkout -q $(MKMF_COMMIT) +#---- +# FMS build -$(EXPERIMENTS_ROOT): - mkdir -p $(@D) - cd $(@D) ; git clone --depth 1 $(CONFIGS_URL) experiments +$(FMS)/lib/libfms.a: $(FMS)/build/Makefile + mkdir -p $(FMS)/lib + cd $(FMS)/build && make NETCDF=3 DEBUG=1 ../lib/libfms.a + +$(FMS)/build/Makefile: $(FMS)/build/path_names + cp $(MKMF_TEMPLATE) $(@D) + cd $(@D) && $(MKMF) \ + -t $(notdir $(MKMF_TEMPLATE)) \ + -p ../lib/libfms.a \ + -c $(MKMF_CPP) \ + path_names -$(REGRESSIONS_ROOT): +$(FMS)/build/path_names: $(FMS)/src $(FMS_FILES) $(LIST_PATHS) mkdir -p $(@D) - cd $(@D) ; git clone --depth 1 $(REGRESSIONS_URL) answers + cd $(@D) && $(LIST_PATHS) -l ../src + +$(FMS)/src: + git clone $(FMS_URL) $@ + cd $@; git checkout $(FMS_COMMIT) + + +#--- +# Build Toolchain + +$(LIST_PATHS) $(MKMF): + git clone $(MKMF_URL) $(DEPS)/mkmf + cd $(DEPS)/mkmf; git checkout $(MKMF_COMMIT) + + +#---- +# Testing + +.PHONY: test +test: $(foreach t,$(TESTS),test.$(t)) + +# NOTE: We remove tc3 (OBC) from grid test since it cannot run asymmetric grids + +.PHONY: $(foreach t,$(TESTS),test.$(t)) +test.regressions: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) +test.grids: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(c).grid $(c).grid.diag) +test.layouts: $(foreach c,$(CONFIGS),$(c).layout $(c).layout.diag) +test.restarts: $(foreach c,$(CONFIGS),$(c).restart) +test.repros: $(foreach c,$(CONFIGS),$(c).repro $(c).repro.diag) +test.nans: $(foreach c,$(CONFIGS),$(c).nan $(c).nan.diag) +test.dims: $(foreach c,$(CONFIGS),$(foreach d,t l h z,$(c).dim.$(d) $(c).dim.$(d).diag)) + +# NOTE: chksum_diag return code of cmp is currently ignored since many fail! +define CMP_RULE +.PRECIOUS: $(foreach b,$(2),$(BASE)/.testing/%/ocean.stats.$(b)) +%.$(1): $(foreach b,$(2),$(BASE)/.testing/%/ocean.stats.$(b)) + cmp $$^ + +.PRECIOUS: $(foreach b,$(2),$(BASE)/.testing/%/chksum_diag.$(b)) +%.$(1).diag: $(foreach b,$(2),$(BASE)/.testing/%/chksum_diag.$(b)) + cmp $$^ || true +endef + +$(eval $(call CMP_RULE,regression,symmetric target)) +$(eval $(call CMP_RULE,grid,symmetric asymmetric)) +$(eval $(call CMP_RULE,layout,symmetric layout)) +$(eval $(call CMP_RULE,repro,symmetric repro)) +$(eval $(call CMP_RULE,nan,symmetric nan)) +$(foreach d,t l h z,$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) + +# Restart tests only compare the final stat record +.PRECIOUS: $(foreach b,symmetric restart,$(BASE)/.testing/%/ocean.stats.$(b)) +%.restart: $(foreach b,symmetric restart,$(BASE)/.testing/%/ocean.stats.$(b)) + cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) + +# TODO: chksum_diag parsing of restart files + + +#--- +# Test run output files + +#(1): Configuration name +#(2): Executable type +#(3): Enable coverage flag +#(4): MOM_override configuration +#(5): Environment variables +#(6): Number of MPI ranks + +# Simple function for generalised Slurm (srun) and OpenMPI (mpirun) support +# (1): Environment variables + +ifeq ($(MPIRUN), srun) +MPIRUN_CMD=$(1) $(MPIRUN) +else +MPIRUN_CMD=$(MPIRUN) $(if $(1),-x $(1),) +endif + +define STAT_RULE +$$(BASE)/.testing/%/ocean.stats.$(1): $$(BUILD)/$(2)/MOM6 + if [ $(3) ]; then find $$(BUILD) -name *.gcda -exec rm -f '{}' \; ; fi + mkdir -p $$(@D)/RESTART + echo $(4) > $$(@D)/MOM_override + cd $$(@D) && $$(call MPIRUN_CMD,$(5)) -n $(6) $$< 2> debug.out + cp $$(@D)/ocean.stats $$@ + > $$(@D)/MOM_override + if [ $(3) ]; then cd $$(BASE) && bash <(curl -s https://codecov.io/bash) -n $$@; fi + +$$(BASE)/.testing/%/chksum_diag.$(1): $$(BASE)/.testing/%/ocean.stats.$(1) + cp $$(@D)/chksum_diag $$@ +endef + +# Define $(,) as comma escape character +, := , + +$(eval $(call STAT_RULE,symmetric,symmetric,$(REPORT_COVERAGE),,,1)) +$(eval $(call STAT_RULE,asymmetric,asymmetric,,,,1)) +$(eval $(call STAT_RULE,target,target,,,,1)) +$(eval $(call STAT_RULE,repro,repro,,,,1)) +$(eval $(call STAT_RULE,layout,symmetric,,LAYOUT=2$(,)1,,2)) +$(eval $(call STAT_RULE,nan,symmetric,,,MALLOC_PERTURB_=256,1)) +$(eval $(call STAT_RULE,dim.t,symmetric,,T_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,dim.l,symmetric,,L_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,dim.h,symmetric,,H_RESCALE_POWER=11,,1)) +$(eval $(call STAT_RULE,dim.z,symmetric,,Z_RESCALE_POWER=11,,1)) + +# Restart tests require signicant preprocessing, and are handled separately. +$(BASE)/.testing/%/ocean.stats.restart: $(BUILD)/symmetric/MOM6 + # Cleanup + mkdir -p $(@D)/RESTART + git checkout $(@D)/input.nml + > $(@D)/MOM_override + # Generate the half-period input namelist + # TODO: Assumes runtime set by DAYMAX, will fail if set by input.nml + cd $(@D) \ + && daymax=$$(grep DAYMAX MOM_input | cut -d '!' -f 1 | cut -d '=' -f 2 | xargs) \ + && timeunit=$$(grep TIMEUNIT MOM_input | cut -d '!' -f 1 | cut -d '=' -f 2 | xargs) \ + && if [ -z "$${timeunit}" ]; then timeunit="8.64e4"; fi \ + && printf -v timeunit_int "%.f" "$${timeunit}" \ + && halfperiod=$$(printf "%.f" $$(bc <<< "scale=10; 0.5 * $${daymax} * $${timeunit_int}")) \ + && printf "\n&ocean_solo_nml\n seconds = $${halfperiod}\n/\n" >> input.nml \ + && echo $${daymax} $${timeunit} + # Run the first half-period + cd $(@D) && $(MPIRUN) -n 1 $< 2> debug.out + # Setup the next inputs + rm -rf $(@D)/INPUT && mv $(@D)/RESTART $(@D)/INPUT + mkdir $(@D)/RESTART + cd $(@D) && sed -i -e "s/input_filename *= *'n'/input_filename = 'r'/g" input.nml + # Run the second half-period + cd $(@D) && $(MPIRUN) -n 1 $< 2> debug.out + # Archive the results and cleanup + cp $(@D)/ocean.stats $@ + rm -rf $(@D)/INPUT + git checkout $(@D)/input.nml + +# TODO: Restart checksum diagnostics + + +#---- +.PHONY: clean +clean: clean.stats + rm -rf $(BUILD) + +.PHONY: clean.stats +clean.stats: + find $(BASE)/.testing -name ocean.stats* -exec rm {} \; + find $(BASE)/.testing -name chksum_diag* -exec rm {} \; diff --git a/.testing/README.md b/.testing/README.md index 46b154da14..a9289a87dd 100644 --- a/.testing/README.md +++ b/.testing/README.md @@ -1,3 +1,216 @@ # .testing -This directory contains scripts used when evaluating commits on Travis-CI +This directory contains the Makefile and test configurations used to evaluate +submissions to the MOM6 codebase. The tests are designed to run either locally +or in a Travis-CI. + + +## Overview + +This section gives a very brief overview of the test suite and how to use it. + +To build and run the model tests +``` +make +make test +``` + +Regression testing is disabled on default. To include regression tests: +``` +make DO_REGRESSION_TESTS=true +make test DO_REGRESSION_TESTS=true +``` + +On platforms other than Gaea, a MKMF build template may be required. To +specify the path to the template: +``` +make MKMF_TEMPLATE=/path/to/template.mk +``` + +To run individual classes of tests, use the subclass name: +``` +make test.grids +make test.layouts +make DO_REGRESSION_TESTS=true test.regressions +``` + +To test an individual test configuration (TC): +``` +make tc0.grid +``` + +The rest of the document describes the test suite in more detail, including +names and descriptions of the test classes and configurations. + + +## Testing overview + +The test suite consists of many comparisons of model output for different model +configurations when subjected to relevant numerical and mathematical +transformations, such as grid layout or dimensional rescaling, for which the +model output should be invariant. If the model state is unchanged after each +transformation, then the test is reported as passing. Any discrepancy in the +model state causes the test to fail. + +Model state is currently defined by the `ocean.stats` output file, which +reports the total energy (per unit mass) at machine precision alongside similar +global metrics, such as mass or mean sea level, at lower precision. + +Clhecksums for every available diagnostic are also compared and the Makefile +will report any differences, but such differences are not yet considered a fail +condition. + + +## Building the executables + +Run `make` to build the test executables. +``` +make +``` +This will fetch the MKMF build toolchain, fetch and compile the FMS framework +library, and compile the executables used in the test suite. The default +configuration uses the symmetric grid in the debug-compile mode, with +optimizations disabled and stronger quality controls. The following +executables will be created: + +- `build/symmetric/MOM6`: Symmetric grid configuration (extended grids along + western and/or southern boundaries). This is the default configuration. + +- `build/asymmetric/MOM6`: Non-symmetric grid (equal-sized grids) + +- `build/repro/MOM6`: Optimized reproducible mode + +- (optional) `build/target/MOM6`: A reference build for regression testing + +The `target` build is only created when the `DO_REGRESSION_TESTS` flag is set +to `true`: +``` +make DO_REGRESSION_TESTS=true +``` +When set, the build will check out a second copy of the repository from a +specified URL and branch given by `MOM_TARGET_URL` and `MOM_TARGET_BRANCH`, +respectively. The code is checked out into the `TARGET_CODEBASE` directory. + +The current default settings are +``` +MOM_TARGET_SLUG = NOAA-GFDL/MOM6 +MOM_TARGET_URL = https://github.com/$(MOM_TARGET_SLUG) +# = https://github.com/NOAA-GFDL/MOM6 +MOM_TARGET_LOCAL_BRANCH = dev/gfdl +MOM_TARGET_BRANCH = origin/$(MOM_TARGET_LOCAL_BRANCH) +# = origin/dev/gfdl +TARGET_CODEBASE = $(BUILD)/target_codebase +``` +These default values can be configured to target a particular development +branch. + + +#### MKMF template + +The MKMF build toolchain requires a template file when building the model. The +default template, `ncrc-gnu.mk`, is part of the MKMF repository, but has been +specifically configured for use on NOAA's Gaea computer, and other institutes +will require their own template files. + +The template can be specified as a Make flag. +``` +make MKMF_TEMPLATE=/path/to/template.mk +``` +The `linux-ubuntu-xenial-gnu.mk` template is provided in the `.testing` +directory, and is intended for Travis-CI builds, but may also be a good +reference point for other Linux distributions. + +In the future, this step may be replaced with a more generalized build system, +such as CMake or automake. + + +## Tests + +Using `test` will run through the test suite. +``` +make test +``` +This will run through the following tests: + +- `test.regressions`: Regression tests relative to a code state (when enabled) +- `test.grids`: Symmetric vs nonsymmetric grids +- `test.layouts`: Domain decomposition, based on parallelization +- `test.restarts`: Resubmission by restarts +- `test.repros`: Optimized (REPRO) and unoptimized (DEBUG) compilation +- `test.nans`: NaN initialization of allocated arrays +- `test.dims`: Dimensional scaling (length, time, thichkness, depth) + +To enable the regression tests, use `DO_REGRESSION_TEST=true`. +``` +make test DO_REGRESSION_TESTS=true +``` + +Each test can also be run individually. For example, the following command +will only run the grid tests. +``` +make test.grids +``` + +Each configuration is tested relative to the `symmetric` build, and reports a +fail if the answers differ from this build. + + +## Test configurations + +The following test configurations (TCs) are supported: + +- TC0: Unit testing of various model components, based on `unit_tests` +- TC1: A low-resolution version of the `benchmark` configuration +- TC2: An ALE configuration based on TC1 +- TC3: An open-boundary condition (OBC) test based on `circle_obcs` + + +## Code coverage + +Code coverage reports the lines of code which have been tested, and can +explicitly demonstrate when a particular operation is untested. + +Coverage is measued using `gcov` and is reported for TCs using the `symmetric` +executable. + +Coverage reporting is optionally sent to the `codecov.io` site. +``` +https://codecov.io/gh/NOAA-GFDL/MOM6 +``` +This is disabled on default, but can be enabled by the `REPORT_COVERAGE` flag. +``` +make test REPORT_COVERAGE=true +``` +Note that any uploads will require a valid token generated by CodeCov. + + +## Running on Travis + +Whenever code is pushed to GitHub or a pull request (PR) is created, the test +suite is triggered and the code changes are tested. + +When the tests are run on Travis, the following variables are re-defined: + +- `DO_REGRESSION_TESTS` is set to `true` for a PR submission, and is unset for + code pushes. + +- `MOM_TARGET_SLUG` is set to `TRAVIS_REPO_SLUG`, the URL stub of the model to + be built. + + For submissions to NOAA-GFDL, this will be set to `NOAA-GFDL/MOM6` and the + reference URL will be `https://github.com/NOAA-GFDL/MOM6`. + +- `MOM_TARGET_LOCAL_BRANCH` is set to `TRAVIS_BRANCH`. + + For a code push, this is set to the name of the active branch at GitHub. For + a PR, this is the name of the branch which is receiving the PR. + +- `REPORT_COVERAGE` is set to `true`. + +## Running under slurm + +By default the executables are invoked using `mpirun`. Under slurm you might need to +use `srun` (such as on GFDL's gaea HPC): +``` +make MPIRUN=srun test +``` diff --git a/.testing/configure b/.testing/configure deleted file mode 100755 index 841635d6f4..0000000000 --- a/.testing/configure +++ /dev/null @@ -1,4 +0,0 @@ -#!/usr/bin/env bash - -echo "Configured!" $MAKEARGS -touch build/test_${MAKEARGS//\ /_} diff --git a/.testing/linux-ubuntu-xenial-gnu.mk b/.testing/linux-ubuntu-xenial-gnu.mk index 80abc4e48d..8c96c8c5c6 100644 --- a/.testing/linux-ubuntu-xenial-gnu.mk +++ b/.testing/linux-ubuntu-xenial-gnu.mk @@ -88,12 +88,12 @@ FFLAGS := -fcray-pointer -fdefault-double-8 -fdefault-real-8 -Waliasing -ffree-l # Flags based on perforance target (production (OPT), reproduction (REPRO), or debug (DEBUG) FFLAGS_OPT = -O3 FFLAGS_REPRO = -O2 -fbounds-check -FFLAGS_DEBUG = -O0 -g -W -fbounds-check -fbacktrace -ffpe-trap=invalid,zero,overflow +FFLAGS_DEBUG = -O0 -g -W -Wno-compare-reals -fbounds-check -fbacktrace -ffpe-trap=invalid,zero,overflow # Flags to add additional build options FFLAGS_OPENMP = -fopenmp FFLAGS_VERBOSE = -FFLAGS_COVERAGE = +FFLAGS_COVERAGE = --coverage # Macro for C preprocessor CPPFLAGS = $(INCLUDES) @@ -111,7 +111,7 @@ CFLAGS_DEBUG = -O0 -g # Flags to add additional build options CFLAGS_OPENMP = -fopenmp CFLAGS_VERBOSE = -CFLAGS_COVERAGE = +CFLAGS_COVERAGE = --coverage # Optional Testing compile flags. Mutually exclusive from DEBUG, REPRO, and OPT # *_TEST will match the production if no new option(s) is(are) to be tested. @@ -122,7 +122,7 @@ CFLAGS_TEST = $(CFLAGS_OPT) LDFLAGS := LDFLAGS_OPENMP := -fopenmp LDFLAGS_VERBOSE := -LDFLAGS_COVERAGE := +LDFLAGS_COVERAGE := --coverage # Start with a blank LIBS LIBS = diff --git a/.testing/tc0/MOM_input b/.testing/tc0/MOM_input new file mode 100644 index 0000000000..217b2d2c3d --- /dev/null +++ b/.testing/tc0/MOM_input @@ -0,0 +1,229 @@ +! This file was written by the model and records the non-default parameters used at run-time. + +! === module MOM === +DO_UNIT_TESTS = True ! [Boolean] default = False + ! If True, exercises unit tests at model start up. +SPLIT = False ! [Boolean] default = True + ! Use the split time stepping if true. +ENABLE_THERMODYNAMICS = False ! [Boolean] default = True + ! If true, Temperature and salinity are used as state + ! variables. +ADIABATIC = True ! [Boolean] default = False + ! There are no diapycnal mass fluxes if ADIABATIC is + ! true. This assumes that KD = KDML = 0.0 and that + ! there is no buoyancy forcing, but makes the model + ! faster by eliminating subroutine calls. +DT = 8.64E+04 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) + +! === module MOM_domains === +NIGLOBAL = 4 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 4 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. + +! === module MOM_hor_index === +! Sets the horizontal array index types. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. +NK = 1 ! [nondim] + ! The number of model layers. + +! === module MOM_tracer_registry === + +! === module MOM_restart === + +! === module MOM_tracer_flow_control === + +! === module MOM_fixed_initialization === + +! === module MOM_grid_init === +GRID_CONFIG = "cartesian" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +SOUTHLAT = 0.0 ! [degrees] + ! The southern latitude of the domain or the equivalent + ! starting value for the y-axis. +LENLAT = 1.0 ! [degrees] + ! The latitudinal or y-direction length of the domain. +LENLON = 1.0 ! [degrees] + ! The longitudinal or x-direction length of the domain. +TOPO_CONFIG = "flat" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! ISOMIP - use a slope and channel configuration for the + ! ISOMIP test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! Phillips - ACC-like idealized topography used in the Phillips config. + ! USER - call a user modified routine. +MAXIMUM_DEPTH = 100.0 ! [m] + ! The maximum depth of the ocean. + +! === module MOM_open_boundary === +! Controls where open boundaries are located, what kind of boundary condition to impose, and what data to apply, if any. + +! === module MOM_coord_initialization === +COORD_CONFIG = "none" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! BFB - Custom coords for buoyancy-forced basin case + ! based on SST_S, T_BOT and DRHO_DT. + ! linear - linear based on interfaces not layers + ! layer_ref - linear based on layer densities + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. + +! === module MOM_grid === +! Parameters providing information about the lateral grid. + +! === module MOM_state_initialization === +THICKNESS_CONFIG = "uniform" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! coord - determined by ALE coordinate. + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! ISOMIP - use a configuration for the + ! ISOMIP test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! soliton - Equatorial Rossby soliton. + ! rossby_front - a mixed layer front in thermal wind balance. + ! USER - call a user modified routine. + +! === module MOM_diag_mediator === + +! === module MOM_MEKE === + +! === module MOM_lateral_mixing_coeffs === + +! === module MOM_set_visc === +BOTTOMDRAGLAW = False ! [Boolean] default = True + ! If true, the bottom stress is calculated with a drag + ! law of the form c_drag*|u|*u. The velocity magnitude + ! may be an assumed value or it may be based on the + ! actual velocity in the bottommost HBBL, depending on + ! LINEAR_DRAG. +HBBL = 1.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL 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. +KV = 1.0 ! [m2 s-1] + ! The background kinematic viscosity in the interior. + ! The molecular value, ~1e-6 m2 s-1, may be used. + +! === module MOM_continuity === + +! === module MOM_continuity_PPM === +SIMPLE_2ND_PPM_CONTINUITY = True ! [Boolean] default = False + ! If true, CONTINUITY_PPM uses a simple 2nd order + ! (arithmetic mean) interpolation of the edge values. + ! This may give better PV conservation propterties. While + ! it formally reduces the accuracy of the continuity + ! solver itself in the strongly advective limit, it does + ! not reduce the overall order of accuracy of the dynamic + ! core. + +! === module MOM_CoriolisAdv === + +! === module MOM_PressureForce === + +! === module MOM_PressureForce_AFV === + +! === module MOM_hor_visc === + +! === module MOM_vert_friction === +HMIX_FIXED = 1.0 ! [m] + ! The prescribed depth over which the near-surface + ! viscosity and diffusivity are elevated when the bulk + ! mixed layer is not used. + +! === module MOM_thickness_diffuse === + +! === module MOM_mixed_layer_restrat === + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === + +! === module MOM_neutral_diffusion === +! This module implements neutral diffusion of tracers + +! === module MOM_surface_forcing === +BUOY_CONFIG = "zero" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), (BFB) and (NONE). +WIND_CONFIG = "zero" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). + +! === module MOM_restart === + +! === module MOM_sum_output === + +! === module MOM_write_cputime === + +! === module MOM_main (MOM_driver) === +DAYMAX = 2.0 ! [days] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set via ocean_solo_nml in input.nml. +ENERGYSAVEDAYS = 1.0 + +! === module MOM_file_parser === + +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc0/MOM_override b/.testing/tc0/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc0/diag_table b/.testing/tc0/diag_table new file mode 100644 index 0000000000..1527de166b --- /dev/null +++ b/.testing/tc0/diag_table @@ -0,0 +1,2 @@ +"Unit tests" +1 1 1 0 0 0 diff --git a/.testing/tc0/input.nml b/.testing/tc0/input.nml new file mode 100644 index 0000000000..961963ea8e --- /dev/null +++ b/.testing/tc0/input.nml @@ -0,0 +1,20 @@ +&MOM_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT' + restart_output_dir = 'RESTART' + parameter_filename = + 'MOM_input', + 'MOM_override', +/ + +&diag_manager_nml +/ + +&fms_nml + domains_stack_size = 710000 + stack_size = 0 +/ + +&ocean_domains_nml +/ diff --git a/.testing/tc1/MOM_input b/.testing/tc1/MOM_input new file mode 100644 index 0000000000..80fdd90860 --- /dev/null +++ b/.testing/tc1/MOM_input @@ -0,0 +1,576 @@ +/* This input file provides the adjustable run-time parameters for version 6 of + the Modular Ocean Model (MOM6), a numerical ocean model developed at NOAA-GFDL. + Where appropriate, parameters use usually given in MKS units. + + This particular file is for the example in benchmark. + + This MOM_input file typically contains only the non-default values that are + needed to reproduce this example. A full list of parameters for this example + can be found in the corresponding MOM_parameter_doc.all file which is + generated by the model at run-time. */ + +!SYMMETRIC_MEMORY_ = False ! [Boolean] + ! If defined, the velocity point data domain includes + ! every face of the thickness points. In other words, + ! some arrays are larger than others, depending on where + ! they are on the staggered grid. Also, the starting + ! index of the velocity-point arrays is usually 0, not 1. + ! This can only be set at compile time. +!STATIC_MEMORY_ = False ! [Boolean] + ! If STATIC_MEMORY_ is defined, the principle variables + ! will have sizes that are statically determined at + ! compile time. Otherwise the sizes are not determined + ! until run time. The STATIC option is substantially + ! faster, but does not allow the PE count to be changed + ! at run time. This can only be set at compile time. +NIHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! x-direction. With STATIC_MEMORY_ this is set as NIHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NIHALO_ in MOM_memory.h (if defined) or 2. +NJHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! y-direction. With STATIC_MEMORY_ this is set as NJHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NJHALO_ in MOM_memory.h (if defined) or 2. +NIGLOBAL = 10 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 8 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +!NIPROC = 12 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!NJPROC = 6 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!LAYOUT = 12, 6 ! + ! The processor layout that was acutally used. +IO_LAYOUT = 1, 1 ! default = 0 + ! The processor layout to be used, or 0,0 to automatically + ! set the io_layout to be the same as the layout. + +! === module MOM_grid === +! Parameters providing information about the vertical grid. +NK = 8 ! [nondim] + ! The number of model layers. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. + +! === module MOM === +THICKNESSDIFFUSE = True ! [Boolean] default = False + ! If true, interfaces or isopycnal surfaces are diffused, + ! depending on the value of FULL_THICKNESSDIFFUSE. +THICKNESSDIFFUSE_FIRST = True ! [Boolean] default = False + ! If true, do thickness diffusion before dynamics. + ! This is only used if THICKNESSDIFFUSE is true. +MIXEDLAYER_RESTRAT = True ! [Boolean] default = False + ! If true, a density-gradient dependent re-stratifying + ! flow is imposed in the mixed layer. + ! This is only used if BULKMIXEDLAYER is true. +DT = 900.0 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) +DT_THERM = 3600.0 ! [s] default = 900.0 + ! The thermodynamic and tracer advection time step. + ! Ideally DT_THERM should be an integer multiple of DT + ! and less than the forcing or coupling time-step. + ! By default DT_THERM is set to DT. +DTBT_RESET_PERIOD = 0.0 ! [s] default = 3600.0 + ! The period between recalculations of DTBT (if DTBT <= 0). + ! If DTBT_RESET_PERIOD is negative, DTBT is set based + ! only on information available at initialization. If + ! dynamic, DTBT will be set at least every forcing time + ! step, and if 0, every dynamics time step. The default is + ! set by DT_THERM. This is only used if SPLIT is true. +FRAZIL = True ! [Boolean] default = False + ! If true, water freezes if it gets too cold, and the + ! the accumulated heat deficit is returned in the + ! surface state. FRAZIL is only used if + ! ENABLE_THERMODYNAMICS is true. +C_P = 3925.0 ! [J kg-1 K-1] default = 3991.86795711963 + ! The heat capacity of sea water, approximated as a + ! constant. This is only used if ENABLE_THERMODYNAMICS is + ! true. The default value is from the TEOS-10 definition + ! of conservative temperature. +SAVE_INITIAL_CONDS = True ! [Boolean] default = False + ! If true, write the initial conditions to a file given + ! by IC_OUTPUT_FILE. +IC_OUTPUT_FILE = "GOLD_IC" ! default = "MOM_IC" + ! The file into which to write the initial conditions. + +! === module MOM_tracer_registry === + +! === module MOM_tracer_flow_control === +USE_IDEAL_AGE_TRACER = True ! [Boolean] default = False + ! If true, use the ideal_age_example tracer package. + +! === module ideal_age_example === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. +COORD_CONFIG = "ts_range" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! linear - linear based on interfaces not layesrs. + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. +TS_RANGE_T_LIGHT = 25.0 ! [degC] default = 10.0 + ! The initial temperature of the lightest layer when + ! COORD_CONFIG is set to ts_range. +TS_RANGE_T_DENSE = 3.0 ! [degC] default = 10.0 + ! The initial temperature of the densest layer when + ! COORD_CONFIG is set to ts_range. +TS_RANGE_RESOLN_RATIO = 5.0 ! [nondim] default = 1.0 + ! The ratio of density space resolution in the densest + ! part of the range to that in the lightest part of the + ! range when COORD_CONFIG is set to ts_range. Values + ! greater than 1 increase the resolution of the denser water. + +! === module MOM_grid_init === +GRID_CONFIG = "mercator" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +SOUTHLAT = -41.0 ! [degrees] + ! The southern latitude of the domain. +LENLAT = 41.0 ! [degrees] + ! The latitudinal length of the domain. +LENLON = 90.0 ! [degrees] + ! The longitudinal length of the domain. +ISOTROPIC = True ! [Boolean] default = False + ! If true, an isotropic grid on a sphere (also known as + ! a Mercator grid) is used. With an isotropic grid, the + ! meridional extent of the domain (LENLAT), the zonal + ! extent (LENLON), and the number of grid points in each + ! direction are _not_ independent. In MOM the meridional + ! extent is determined to fit the zonal extent and the + ! number of grid points, while grid is perfectly isotropic. +TOPO_CONFIG = "benchmark" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! USER - call a user modified routine. + +! === module benchmark_initialize_topography === +MINIMUM_DEPTH = 1.0 ! [m] default = 0.0 + ! The minimum depth of the ocean. +MAXIMUM_DEPTH = 5500.0 ! [m] + ! The maximum depth of the ocean. +THICKNESS_CONFIG = "benchmark" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. +TS_CONFIG = "benchmark" ! + ! A string that determines how the initial tempertures + ! and salinities are specified for a new run: + ! file - read velocities from the file specified + ! by (TS_FILE). + ! fit - find the temperatures that are consistent with + ! the layer densities and salinity S_REF. + ! TS_profile - use temperature and salinity profiles + ! (read from TS_FILE) to set layer densities. + ! benchmark - use the benchmark test case T & S. + ! linear - linear in logical layer space. + ! DOME2D - 2D DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. + +! === module MOM_MEKE === + +! === module MOM_lateral_mixing_coeffs === +USE_VARIABLE_MIXING = True ! [Boolean] default = False + ! If true, the variable mixing code will be called. This + ! allows diagnostics to be created even if the scheme is + ! not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, + ! this is set to true regardless of what is in the + ! parameter file. +USE_VISBECK = True ! [Boolean] default = False + ! If true, use the Visbeck et al. (1997) formulation for + ! thickness diffusivity. +RESOLN_SCALED_KH = True ! [Boolean] default = False + ! If true, the Laplacian lateral viscosity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTH = True ! [Boolean] default = False + ! If true, the interface depth diffusivity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTR = True ! [Boolean] default = False + ! If true, the epipycnal tracer diffusivity is scaled + ! away when the first baroclinic deformation radius is + ! well resolved. +KHTH_SLOPE_CFF = 0.1 ! [nondim] default = 0.0 + ! The nondimensional coefficient in the Visbeck formula + ! for the interface depth diffusivity +KHTR_SLOPE_CFF = 0.1 ! [nondim] default = 0.0 + ! The nondimensional coefficient in the Visbeck formula + ! for the epipycnal tracer diffusivity +VARMIX_KTOP = 6 ! [nondim] default = 2 + ! The layer number at which to start vertical integration + ! of S*N for purposes of finding the Eady growth rate. +VISBECK_L_SCALE = 3.0E+04 ! [m] default = 0.0 + ! The fixed length scale in the Visbeck formula. + +! === module MOM_wave_speed === +ETA_TOLERANCE = 1.0E-06 ! [m] default = 1.1E-09 + ! The tolerance for the differences between the + ! barotropic and baroclinic estimates of the sea surface + ! height due to the fluxes through each face. The total + ! tolerance for SSH is 4 times this value. The default + ! is 0.5*NK*ANGSTROM, and this should not be set less x + ! than about 10^-15*MAXIMUM_DEPTH. +VELOCITY_TOLERANCE = 0.001 ! [m s-1] default = 3.0E+08 + ! The tolerance for barotropic velocity discrepancies + ! between the barotropic solution and the sum of the + ! layer thicknesses. +BOUND_CORIOLIS = True ! [Boolean] default = False + ! If true, the Coriolis terms at u-points are bounded by + ! the four estimates of (f+rv)v from the four neighboring + ! v-points, and similarly at v-points. This option would + ! have no effect on the SADOURNY Coriolis scheme if it + ! were possible to use centered difference thickness fluxes. + +! === module MOM_hor_visc === +AH_VEL_SCALE = 0.05 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the cube of + ! the grid spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and AH. +SMAGORINSKY_AH = True ! [Boolean] default = False + ! If true, use a biharmonic Smagorinsky nonlinear eddy + ! viscosity. +SMAG_BI_CONST = 0.06 ! [nondim] default = 0.0 + ! The nondimensional biharmonic Smagorinsky constant, + ! typically 0.015 - 0.06. + +! === module MOM_vert_friction === +PRANDTL_TURB = 0.0 ! [nondim] default = 1.0 + ! The turbulent Prandtl number applied to shear + ! instability. +DYNAMIC_VISCOUS_ML = True ! [Boolean] default = False + ! If true, use a bulk Richardson number criterion to + ! determine the mixed layer thickness for viscosity. +U_TRUNC_FILE = "U_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to zonal velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +V_TRUNC_FILE = "V_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to meridional velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +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. +HBBL = 10.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL 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. +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity + ! components are truncated. + +! === module MOM_PointAccel === + +! === module MOM_set_visc === +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) + ! shear mixing parameterization. +ML_OMEGA_FRAC = 1.0 ! [nondim] default = 0.0 + ! When setting the decay scale for turbulence, use this + ! fraction of the absolute rotation rate blended with the + ! local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). +DRAG_BG_VEL = 0.1 ! [m s-1] default = 0.0 + ! DRAG_BG_VEL is either the assumed bottom velocity (with + ! LINEAR_DRAG) or an unresolved velocity that is + ! combined with the resolved velocity to estimate the + ! velocity magnitude. DRAG_BG_VEL is only used when + ! BOTTOMDRAGLAW is defined. +BBL_THICK_MIN = 0.1 ! [m] default = 0.0 + ! 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 + ! near-bottom viscosity. + +! === module MOM_barotropic === +BOUND_BT_CORRECTION = True ! [Boolean] default = False + ! If true, the corrective pseudo mass-fluxes into the + ! barotropic solver are limited to values that require + ! less than 0.1*MAXVEL to be accommodated. +!BT x-halo = 0 ! + ! The barotropic x-halo size that is actually used. +!BT y-halo = 0 ! + ! The barotropic y-halo size that is actually used. +NONLINEAR_BT_CONTINUITY = True ! [Boolean] default = False + ! If true, use nonlinear transports in the barotropic + ! continuity equation. This does not apply if + ! USE_BT_CONT_TYPE is true. +BT_PROJECT_VELOCITY = True ! [Boolean] default = False + ! If true, step the barotropic velocity first and project + ! out the velocity tendancy by 1+BEBT when calculating the + ! transport. The default (false) is to use a predictor + ! continuity step to find the pressure field, and then + ! to do a corrector continuity step using a weighted + ! average of the old and new velocities, with weights + ! of (1-BEBT) and BEBT. +BT_THICK_SCHEME = "FROM_BT_CONT" ! default = "HYBRID" + ! A string describing the scheme that is used to set the + ! open face areas used for barotropic transport and the + ! relative weights of the accelerations. Valid values are: + ! ARITHMETIC - arithmetic mean layer thicknesses + ! HARMONIC - harmonic mean layer thicknesses + ! HYBRID (the default) - use arithmetic means for + ! layers above the shallowest bottom, the harmonic + ! mean for layers below, and a weighted average for + ! layers that straddle that depth + ! FROM_BT_CONT - use the average thicknesses kept + ! in the h_u and h_v fields of the BT_cont_type +BEBT = 0.2 ! [nondim] default = 0.1 + ! BEBT determines whether the barotropic time stepping + ! uses the forward-backward time-stepping scheme or a + ! backward Euler scheme. BEBT is valid in the range from + ! 0 (for a forward-backward treatment of nonrotating + ! gravity waves) to 1 (for a backward Euler treatment). + ! In practice, BEBT must be greater than about 0.05. +DTBT = -0.95 ! [s or nondim] default = -0.98 + ! The barotropic time step, in s. DTBT is only used with + ! the split explicit time stepping. To set the time step + ! automatically based the maximum stable value use 0, or + ! a negative value gives the fraction of the stable value. + ! Setting DTBT to 0 is the same as setting it to -0.98. + ! The value of DTBT that will actually be used is an + ! integer fraction of DT, rounding down. + +! === module MOM_thickness_diffuse === +KHTH = 1.0 ! [m2 s-1] default = 0.0 + ! The background horizontal thickness diffusivity. +KHTH_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum horizontal thickness diffusivity. + +! === module MOM_mixed_layer_restrat === +FOX_KEMPER_ML_RESTRAT_COEF = 5.0 ! [nondim] default = 0.0 + ! A nondimensional coefficient that is proportional to + ! the ratio of the deformation radius to the dominant + ! lengthscale of the submesoscale mixed layer + ! instabilities, times the minimum of the ratio of the + ! mesoscale eddy kinetic energy to the large-scale + ! geostrophic kinetic energy or 1 plus the square of the + ! grid spacing over the deformation radius, as detailed + ! by Fox-Kemper et al. (2010) + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. +RECLAIM_FRAZIL = False ! [Boolean] default = True + ! If true, try to use any frazil heat deficit to cool any + ! overlying layers down to the freezing point, thereby + ! avoiding the creation of thin ice when the SST is above + ! the freezing point. +KD = 2.0E-05 ! [m2 s-1] + ! The background diapycnal diffusivity of density in the + ! interior. Zero or the molecular value, ~1e-7 m2 s-1, + ! may be used. + +! === module MOM_KPP === +! This is the MOM wrapper to CVmix:KPP +! See http://code.google.com/p/cvmix/ +KPP% +%KPP + +! === module MOM_diffConvection === +! This module implements enhanced diffusivity as a +! function of static stability, N^2. +CONVECTION% +%CONVECTION + +! === module MOM_entrain_diffusive === +MAX_ENT_IT = 20 ! default = 5 + ! The maximum number of iterations that may be used to + ! calculate the interior diapycnal entrainment. +TOLERANCE_ENT = 1.0E-05 ! [m] default = 1.341640786499874E-05 + ! The tolerance with which to solve for entrainment values. + +! === module MOM_kappa_shear === +MAX_RINO_IT = 25 ! [nondim] default = 50 + ! The maximum number of iterations that may be used to + ! estimate the Richardson number driven mixing. + +! === module MOM_mixed_layer === +BULK_RI_ML = 0.05 ! [nondim] + ! The efficiency with which mean kinetic energy released + ! by mechanically forced entrainment of the mixed layer + ! is converted to turbulent kinetic energy. +ABSORB_ALL_SW = True ! [Boolean] default = False + ! If true, all shortwave radiation is absorbed by the + ! ocean, instead of passing through to the bottom mud. +MSTAR = 0.3 ! [units=nondim] default = 1.2 + ! The ratio of the friction velocity cubed to the TKE + ! input to the mixed layer. +TKE_DECAY = 10.0 ! [nondim] default = 2.5 + ! TKE_DECAY relates the vertical rate of decay of the + ! TKE available for mechanical entrainment to the natural + ! Ekman depth. +HMIX_MIN = 2.0 ! [m] default = 0.0 + ! The minimum mixed layer depth if the mixed layer depth + ! is determined dynamically. +LIMIT_BUFFER_DETRAIN = True ! [Boolean] default = False + ! If true, limit the detrainment from the buffer layers + ! to not be too different from the neighbors. +DEPTH_LIMIT_FLUXES = 0.1 ! [m] default = 0.2 + ! The surface fluxes are scaled away when the total ocean + ! depth is less than DEPTH_LIMIT_FLUXES. +CORRECT_ABSORPTION_DEPTH = True ! [Boolean] default = False + ! If true, the depth at which penetrating shortwave + ! radiation is absorbed is corrected by moving some of + ! the heating upward in the water column. + +! === module MOM_regularize_layers === + +! === module MOM_opacity === +PEN_SW_SCALE = 15.0 ! [m] default = 0.0 + ! The vertical absorption e-folding depth of the + ! penetrating shortwave radiation. +PEN_SW_FRAC = 0.42 ! [nondim] default = 0.0 + ! The fraction of the shortwave radiation that penetrates + ! below the surface. + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === +KHTR = 1.0 ! [m2 s-1] default = 0.0 + ! The background along-isopycnal tracer diffusivity. +KHTR_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum along-isopycnal tracer diffusivity. +DIFFUSE_ML_TO_INTERIOR = True ! [Boolean] default = False + ! If true, enable epipycnal mixing between the surface + ! boundary layer and the interior. +ML_KHTR_SCALE = 0.0 ! [nondim] default = 1.0 + ! With Diffuse_ML_interior, the ratio of the truly + ! horizontal diffusivity in the mixed layer to the + ! epipycnal diffusivity. The valid range is 0 to 1. + +! === module MOM_surface_forcing === +BUOY_CONFIG = "linear" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), and (NONE). +WIND_CONFIG = "gyres" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). +TAUX_SIN_AMP = 0.1 ! [Pa] default = 0.0 + ! With the gyres wind_config, the sine amplitude in the + ! zonal wind stress profile: + ! B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +TAUX_N_PIS = 1.0 ! [nondim] default = 0.0 + ! With the gyres wind_config, the number of gyres in + ! the zonal wind stress profile: + ! n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +RESTOREBUOY = True ! [Boolean] default = False + ! If true, the buoyancy fluxes drive the model back + ! toward some specified surface state with a rate + ! given by FLUXCONST. +FLUXCONST = 0.5 ! [m day-1] + ! The constant that relates the restoring surface fluxes + ! to the relative surface anomalies (akin to a piston + ! velocity). Note the non-MKS units. +SST_NORTH = 27.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the northern end of the domain toward which to + ! to restore. +SST_SOUTH = 3.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the southern end of the domain toward which to + ! to restore. + +! === module MOM_sum_output === +MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 + ! The run will be stopped, and the day set to a very + ! large value if the velocity is truncated more than + ! MAXTRUNC times between energy saves. Set MAXTRUNC to 0 + ! to stop if there is any truncation of velocities. +MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 + ! The maximum amount of cpu time per processor for which + ! MOM should run before saving a restart file and + ! quitting with a return value that indicates that a + ! further run is required to complete the simulation. + ! If automatic restarts are not desired, use a negative + ! value for MAXCPU. MAXCPU has units of wall-clock + ! seconds, so the actual CPU time used is larger by a + ! factor of the number of processors used. + +! === module MOM_main (MOM_driver) === +DT_FORCING = 3600.0 ! [s] default = 900.0 + ! The time step for changing forcing, coupling with other + ! components, or potentially writing certain diagnostics. + ! The default value is given by DT. +DAYMAX = 0.25 ! [days] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set (as it was here) via ocean_solo_nml in input.nml. +RESTART_CONTROL = 3 ! default = 1 + ! An integer whose bits encode which restart files are + ! written. Add 2 (bit 1) for a time-stamped file, and odd + ! (bit 0) for a non-time-stamped file. A non-time-stamped + ! restart file is saved at the end of the run segment + ! for any non-negative value. +RESTINT = 365.0 ! [days] default = 0.0 + ! The interval between saves of the restart file in units + ! of TIMEUNIT. Use 0 (the default) to not save + ! incremental restart files at all. +ENERGYSAVEDAYS = 0.125 ! [days] default = 3600.0 + ! The interval in units of TIMEUNIT between saves of the + ! energies of the run and other globally summed diagnostics. +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc1/MOM_override b/.testing/tc1/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc1/diag_table b/.testing/tc1/diag_table new file mode 100644 index 0000000000..19d6a32e1e --- /dev/null +++ b/.testing/tc1/diag_table @@ -0,0 +1,86 @@ +"MOM benchmark Experiment" +1 1 1 0 0 0 +"prog", 1,"days",1,"days","time", +#"ave_prog", 5,"days",1,"days","Time",365,"days" +#"cont", 5,"days",1,"days","Time",365,"days" + +#This is the field section of the diag_table. + +# Prognostic Ocean fields: +#========================= + +"ocean_model","u","u","prog","all",.false.,"none",2 +"ocean_model","v","v","prog","all",.false.,"none",2 +"ocean_model","h","h","prog","all",.false.,"none",1 +"ocean_model","e","e","prog","all",.false.,"none",2 +"ocean_model","temp","temp","prog","all",.false.,"none",2 +#"ocean_model","salt","salt","prog","all",.false.,"none",2 + +#"ocean_model","u","u","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","v","v","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h","h","ave_prog_%4yr_%3dy","all",.true.,"none",1 +#"ocean_model","e","e","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +# Auxilary Tracers: +#================== +#"ocean_model","vintage","vintage","prog_%4yr_%3dy","all",.false.,"none",2 +#"ocean_model","age","age","prog_%4yr_%3dy","all",.false.,"none",2 + +# Continuity Equation Terms: +#=========================== +#"ocean_model","dhdt","dhdt","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","wd","wd","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh","uh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh","vh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h_rho","h_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh_rho","uh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh_rho","vh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uhGM_rho","uhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vhGM_rho","vhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 + +# +# Tracer Fluxes: +#================== +#"ocean_model","T_adx", "T_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_ady", "T_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffx","T_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffy","T_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_adx", "S_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_ady", "S_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffx","S_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffy","S_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +#============================================================================================= +# +#===- This file can be used with diag_manager/v2.0a (or higher) ==== +# +# +# FORMATS FOR FILE ENTRIES (not all input values are used) +# ------------------------ +# +#"file_name", output_freq, "output_units", format, "time_units", "time_long_name", ... +# (opt) new_file_frequecy, (opt) "new_file_freq_units", "new_file_start_date" +# +# +#output_freq: > 0 output frequency in "output_units" +# = 0 output frequency every time step +# =-1 output frequency at end of run +# +#output_units = units used for output frequency +# (years, months, days, minutes, hours, seconds) +# +#time_units = units used to label the time axis +# (days, minutes, hours, seconds) +# +# +# FORMAT FOR FIELD ENTRIES (not all input values are used) +# ------------------------ +# +#"module_name", "field_name", "output_name", "file_name" "time_sampling", time_avg, "other_opts", packing +# +#time_avg = .true. or .false. +# +#packing = 1 double precision +# = 2 float +# = 4 packed 16-bit integers +# = 8 packed 1-byte (not tested?) diff --git a/.testing/tc1/input.nml b/.testing/tc1/input.nml new file mode 100644 index 0000000000..54b26920b1 --- /dev/null +++ b/.testing/tc1/input.nml @@ -0,0 +1,19 @@ +&mom_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT/' + restart_output_dir = 'RESTART/' + parameter_filename = + 'MOM_input', + 'MOM_override', +/ + +&diag_manager_nml +/ + +&fms_nml + clock_grain = 'ROUTINE' + clock_flags = 'SYNC' + domains_stack_size = 955296 + stack_size = 0 +/ diff --git a/.testing/tc2/MOM_input b/.testing/tc2/MOM_input new file mode 100644 index 0000000000..9b36f2675c --- /dev/null +++ b/.testing/tc2/MOM_input @@ -0,0 +1,614 @@ +/* This input file provides the adjustable run-time parameters for version 6 of + the Modular Ocean Model (MOM6), a numerical ocean model developed at NOAA-GFDL. + Where appropriate, parameters use usually given in MKS units. + + This particular file is for the example in benchmark. + + This MOM_input file typically contains only the non-default values that are + needed to reproduce this example. A full list of parameters for this example + can be found in the corresponding MOM_parameter_doc.all file which is + generated by the model at run-time. */ + +!SYMMETRIC_MEMORY_ = False ! [Boolean] + ! If defined, the velocity point data domain includes + ! every face of the thickness points. In other words, + ! some arrays are larger than others, depending on where + ! they are on the staggered grid. Also, the starting + ! index of the velocity-point arrays is usually 0, not 1. + ! This can only be set at compile time. +!STATIC_MEMORY_ = False ! [Boolean] + ! If STATIC_MEMORY_ is defined, the principle variables + ! will have sizes that are statically determined at + ! compile time. Otherwise the sizes are not determined + ! until run time. The STATIC option is substantially + ! faster, but does not allow the PE count to be changed + ! at run time. This can only be set at compile time. +NIHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! x-direction. With STATIC_MEMORY_ this is set as NIHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NIHALO_ in MOM_memory.h (if defined) or 2. +NJHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! y-direction. With STATIC_MEMORY_ this is set as NJHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NJHALO_ in MOM_memory.h (if defined) or 2. +NIGLOBAL = 10 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 8 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +!NIPROC = 12 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!NJPROC = 6 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!LAYOUT = 12, 6 ! + ! The processor layout that was acutally used. +IO_LAYOUT = 1, 1 ! default = 0 + ! The processor layout to be used, or 0,0 to automatically + ! set the io_layout to be the same as the layout. + +! === module MOM_grid === +! Parameters providing information about the vertical grid. +NK = 8 ! [nondim] + ! The number of model layers. + +USE_REGRIDDING = True ! [Boolean] default = False + ! If True, use the ALE algorithm (regridding/remapping). If False, use the + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. + +! === module MOM === +THICKNESSDIFFUSE = True ! [Boolean] default = False + ! If true, interfaces or isopycnal surfaces are diffused, + ! depending on the value of FULL_THICKNESSDIFFUSE. +THICKNESSDIFFUSE_FIRST = True ! [Boolean] default = False + ! If true, do thickness diffusion before dynamics. + ! This is only used if THICKNESSDIFFUSE is true. +MIXEDLAYER_RESTRAT = True ! [Boolean] default = False + ! If true, a density-gradient dependent re-stratifying + ! flow is imposed in the mixed layer. + ! This is only used if BULKMIXEDLAYER is true. +DT = 3600.0 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) +DT_THERM = 7200.0 ! [s] default = 900.0 + ! The thermodynamic and tracer advection time step. + ! Ideally DT_THERM should be an integer multiple of DT + ! and less than the forcing or coupling time-step. + ! By default DT_THERM is set to DT. +DTBT_RESET_PERIOD = -.98 ! [s] default = 3600.0 + ! The period between recalculations of DTBT (if DTBT <= 0). + ! If DTBT_RESET_PERIOD is negative, DTBT is set based + ! only on information available at initialization. If + ! dynamic, DTBT will be set at least every forcing time + ! step, and if 0, every dynamics time step. The default is + ! set by DT_THERM. This is only used if SPLIT is true. +FRAZIL = True ! [Boolean] default = False + ! If true, water freezes if it gets too cold, and the + ! the accumulated heat deficit is returned in the + ! surface state. FRAZIL is only used if + ! ENABLE_THERMODYNAMICS is true. +C_P = 3925.0 ! [J kg-1 K-1] default = 3991.86795711963 + ! The heat capacity of sea water, approximated as a + ! constant. This is only used if ENABLE_THERMODYNAMICS is + ! true. The default value is from the TEOS-10 definition + ! of conservative temperature. +SAVE_INITIAL_CONDS = True ! [Boolean] default = False + ! If true, write the initial conditions to a file given + ! by IC_OUTPUT_FILE. +IC_OUTPUT_FILE = "GOLD_IC" ! default = "MOM_IC" + ! The file into which to write the initial conditions. + +! === module MOM_tracer_registry === + +! === module MOM_tracer_flow_control === +USE_IDEAL_AGE_TRACER = True ! [Boolean] default = False + ! If true, use the ideal_age_example tracer package. + +! === module ideal_age_example === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. +COORD_CONFIG = "ALE" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! linear - linear based on interfaces not layesrs. + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. +REGRIDDING_COORDINATE_MODE = "Z*" ! default = "LAYER" + ! Coordinate mode for vertical regridding. Choose among the following + ! possibilities: LAYER - Isopycnal or stacked shallow water layers + ! ZSTAR, Z* - stretched geopotential z* + ! SIGMA_SHELF_ZSTAR - stretched geopotential z* ignoring shelf + ! SIGMA - terrain following coordinates + ! RHO - continuous isopycnal + ! HYCOM1 - HyCOM-like hybrid coordinate + ! SLIGHT - stretched coordinates above continuous isopycnal + ! ADAPTIVE - optimize for smooth neutral density surfaces +REMAPPING_SCHEME = "PPM_IH4" ! default = "PLM" + ! This sets the reconstruction scheme used for vertical remapping for all + ! variables. It can be one of the following schemes: PCM (1st-order + ! accurate) + ! PLM (2nd-order accurate) + ! PPM_H4 (3rd-order accurate) + ! PPM_IH4 (3rd-order accurate) + ! PQM_IH4IH3 (4th-order accurate) + ! PQM_IH6IH5 (5th-order accurate) + +! === module MOM_grid_init === +GRID_CONFIG = "spherical" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +SOUTHLAT = -21.0 ! [degrees] + ! The southern latitude of the domain. +LENLAT = 42.0 ! [degrees] + ! The latitudinal length of the domain. +LENLON = 90.0 ! [degrees] + ! The longitudinal length of the domain. +TOPO_CONFIG = "halfpipe" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! USER - call a user modified routine. + +! === module benchmark_initialize_topography === +MINIMUM_DEPTH = 1.0 ! [m] default = 0.0 + ! The minimum depth of the ocean. +MAXIMUM_DEPTH = 4500.0 ! [m] + ! The maximum depth of the ocean. +THICKNESS_CONFIG = "uniform" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. +TS_CONFIG = "benchmark" ! + ! A string that determines how the initial tempertures + ! and salinities are specified for a new run: + ! file - read velocities from the file specified + ! by (TS_FILE). + ! fit - find the temperatures that are consistent with + ! the layer densities and salinity S_REF. + ! TS_profile - use temperature and salinity profiles + ! (read from TS_FILE) to set layer densities. + ! benchmark - use the benchmark test case T & S. + ! linear - linear in logical layer space. + ! DOME2D - 2D DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. + +! === module MOM_MEKE === +USE_MEKE = True ! [Boolean] default = False + ! If true, turns on the MEKE scheme which calculates a sub-grid mesoscale eddy + ! kinetic energy budget. +MEKE_GMCOEFF = 1.0 ! [nondim] default = -1.0 + ! The efficiency of the conversion of potential energy into MEKE by the + ! thickness mixing parameterization. If MEKE_GMCOEFF is negative, this + ! conversion is not used or calculated. +MEKE_BGSRC = 1.0E-13 ! [W kg-1] default = 0.0 + ! A background energy source for MEKE. +MEKE_KHTH_FAC = 0.5 ! [nondim] default = 0.0 + ! A factor that maps MEKE%Kh to KhTh. +MEKE_KHTR_FAC = 0.5 ! [nondim] default = 0.0 + ! A factor that maps MEKE%Kh to KhTr. +MEKE_KHMEKE_FAC = 1.0 ! [nondim] default = 0.0 + ! A factor that maps MEKE%Kh to Kh for MEKE itself. +MEKE_VISCOSITY_COEFF_KU = 1.0 ! [nondim] default = 0.0 + ! If non-zero, is the scaling coefficient in the expression forviscosity used to + ! parameterize harmonic lateral momentum mixing byunresolved eddies represented + ! by MEKE. Can be negative torepresent backscatter from the unresolved eddies. +MEKE_ALPHA_RHINES = 0.15 ! [nondim] default = 0.05 + ! If positive, is a coefficient weighting the Rhines scale in the expression for + ! mixing length used in MEKE-derived diffusivity. +MEKE_ALPHA_EADY = 0.15 ! [nondim] default = 0.05 + ! If positive, is a coefficient weighting the Eady length scale in the + ! expression for mixing length used in MEKE-derived diffusivity. + +! === module MOM_lateral_mixing_coeffs === +USE_VARIABLE_MIXING = True ! [Boolean] default = False + ! If true, the variable mixing code will be called. This + ! allows diagnostics to be created even if the scheme is + ! not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, + ! this is set to true regardless of what is in the + ! parameter file. +USE_VISBECK = False ! [Boolean] default = False + ! If true, use the Visbeck et al. (1997) formulation for + ! thickness diffusivity. +RESOLN_SCALED_KH = False ! [Boolean] default = False + ! If true, the Laplacian lateral viscosity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTH = False ! [Boolean] default = False + ! If true, the interface depth diffusivity is scaled away + ! when the first baroclinic deformation radius is well + ! resolved. +RESOLN_SCALED_KHTR = False ! [Boolean] default = False + ! If true, the epipycnal tracer diffusivity is scaled + ! away when the first baroclinic deformation radius is + ! well resolved. +USE_STORED_SLOPES = True ! [Boolean] default = False + ! If true, the isopycnal slopes are calculated once and stored for re-use. This + ! uses more memory but avoids calling the equation of state more times than + +! === module MOM_wave_speed === +ETA_TOLERANCE = 1.0E-06 ! [m] default = 1.1E-09 + ! The tolerance for the differences between the + ! barotropic and baroclinic estimates of the sea surface + ! height due to the fluxes through each face. The total + ! tolerance for SSH is 4 times this value. The default + ! is 0.5*NK*ANGSTROM, and this should not be set less x + ! than about 10^-15*MAXIMUM_DEPTH. +VELOCITY_TOLERANCE = 0.001 ! [m s-1] default = 3.0E+08 + ! The tolerance for barotropic velocity discrepancies + ! between the barotropic solution and the sum of the + ! layer thicknesses. +BOUND_CORIOLIS = True ! [Boolean] default = False + ! If true, the Coriolis terms at u-points are bounded by + ! the four estimates of (f+rv)v from the four neighboring + ! v-points, and similarly at v-points. This option would + ! have no effect on the SADOURNY Coriolis scheme if it + ! were possible to use centered difference thickness fluxes. + +! === module MOM_hor_visc === +LAPLACIAN = True +KH_VEL_SCALE = 0.05 +SMAGORINSKY_KH = True ! [Boolean] default = False +SMAG_LAP_CONST = 0.06 ! [nondim] default = 0.0 +AH_VEL_SCALE = 0.05 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the cube of + ! the grid spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and AH. +SMAGORINSKY_AH = True ! [Boolean] default = False + ! If true, use a biharmonic Smagorinsky nonlinear eddy + ! viscosity. +SMAG_BI_CONST = 0.06 ! [nondim] default = 0.0 + ! The nondimensional biharmonic Smagorinsky constant, + ! typically 0.015 - 0.06. + +! === module MOM_vert_friction === +ENERGETICS_SFC_PBL = True +DO_GEOTHERMAL = True +GEOTHERMAL_SCALE = 0.05 +TIDES = True +TIDE_M2 = True +TIDE_S2 = True +TIDE_N2 = True +TIDE_K2 = True +TIDE_K1 = True +TIDE_O1 = True +TIDE_P1 = True +TIDE_Q1 = True +TIDE_MF = True +TIDE_MM = True +TIDE_SAL_SCALAR_VALUE = 1. +USE_NEUTRAL_DIFFUSION = True +DYNAMIC_VISCOUS_ML = True ! [Boolean] default = False + ! If true, use a bulk Richardson number criterion to + ! determine the mixed layer thickness for viscosity. +U_TRUNC_FILE = "U_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to zonal velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +V_TRUNC_FILE = "V_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to meridional velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +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. +HMIX_FIXED = 0.5 ! [m] + ! The prescribed depth over which the near-surface viscosity and diffusivity are + ! elevated when the bulk mixed layer is not used. +CHANNEL_DRAG = True ! [Boolean] default = False +HBBL = 10.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL 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. +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity + ! components are truncated. + +! === module MOM_PointAccel === + +! === module MOM_set_visc === +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) + ! shear mixing parameterization. +ML_OMEGA_FRAC = 1.0 ! [nondim] default = 0.0 + ! When setting the decay scale for turbulence, use this + ! fraction of the absolute rotation rate blended with the + ! local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). +DRAG_BG_VEL = 0.1 ! [m s-1] default = 0.0 + ! DRAG_BG_VEL is either the assumed bottom velocity (with + ! LINEAR_DRAG) or an unresolved velocity that is + ! combined with the resolved velocity to estimate the + ! velocity magnitude. DRAG_BG_VEL is only used when + ! BOTTOMDRAGLAW is defined. +BBL_THICK_MIN = 0.1 ! [m] default = 0.0 + ! 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 + ! near-bottom viscosity. + +! === module MOM_barotropic === +BOUND_BT_CORRECTION = True ! [Boolean] default = False + ! If true, the corrective pseudo mass-fluxes into the + ! barotropic solver are limited to values that require + ! less than 0.1*MAXVEL to be accommodated. +!BT x-halo = 0 ! + ! The barotropic x-halo size that is actually used. +!BT y-halo = 0 ! + ! The barotropic y-halo size that is actually used. +NONLINEAR_BT_CONTINUITY = True ! [Boolean] default = False + ! If true, use nonlinear transports in the barotropic + ! continuity equation. This does not apply if + ! USE_BT_CONT_TYPE is true. +BT_PROJECT_VELOCITY = True ! [Boolean] default = False + ! If true, step the barotropic velocity first and project + ! out the velocity tendancy by 1+BEBT when calculating the + ! transport. The default (false) is to use a predictor + ! continuity step to find the pressure field, and then + ! to do a corrector continuity step using a weighted + ! average of the old and new velocities, with weights + ! of (1-BEBT) and BEBT. +BT_THICK_SCHEME = "FROM_BT_CONT" ! default = "HYBRID" + ! A string describing the scheme that is used to set the + ! open face areas used for barotropic transport and the + ! relative weights of the accelerations. Valid values are: + ! ARITHMETIC - arithmetic mean layer thicknesses + ! HARMONIC - harmonic mean layer thicknesses + ! HYBRID (the default) - use arithmetic means for + ! layers above the shallowest bottom, the harmonic + ! mean for layers below, and a weighted average for + ! layers that straddle that depth + ! FROM_BT_CONT - use the average thicknesses kept + ! in the h_u and h_v fields of the BT_cont_type +BEBT = 0.2 ! [nondim] default = 0.1 + ! BEBT determines whether the barotropic time stepping + ! uses the forward-backward time-stepping scheme or a + ! backward Euler scheme. BEBT is valid in the range from + ! 0 (for a forward-backward treatment of nonrotating + ! gravity waves) to 1 (for a backward Euler treatment). + ! In practice, BEBT must be greater than about 0.05. +DTBT = -0.95 ! [s or nondim] default = -0.98 + ! The barotropic time step, in s. DTBT is only used with + ! the split explicit time stepping. To set the time step + ! automatically based the maximum stable value use 0, or + ! a negative value gives the fraction of the stable value. + ! Setting DTBT to 0 is the same as setting it to -0.98. + ! The value of DTBT that will actually be used is an + ! integer fraction of DT, rounding down. + +! === module MOM_thickness_diffuse === +KHTH = 1.0 ! [m2 s-1] default = 0.0 + ! The background horizontal thickness diffusivity. +KHTH_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum horizontal thickness diffusivity. + +! === module MOM_mixed_layer_restrat === +FOX_KEMPER_ML_RESTRAT_COEF = 5.0 ! [nondim] default = 0.0 + ! A nondimensional coefficient that is proportional to + ! the ratio of the deformation radius to the dominant + ! lengthscale of the submesoscale mixed layer + ! instabilities, times the minimum of the ratio of the + ! mesoscale eddy kinetic energy to the large-scale + ! geostrophic kinetic energy or 1 plus the square of the + ! grid spacing over the deformation radius, as detailed + ! by Fox-Kemper et al. (2010) + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. +RECLAIM_FRAZIL = False ! [Boolean] default = True + ! If true, try to use any frazil heat deficit to cool any + ! overlying layers down to the freezing point, thereby + ! avoiding the creation of thin ice when the SST is above + ! the freezing point. +KD = 2.0E-05 ! [m2 s-1] + ! The background diapycnal diffusivity of density in the + ! interior. Zero or the molecular value, ~1e-7 m2 s-1, + ! may be used. + +! === module MOM_KPP === +! This is the MOM wrapper to CVmix:KPP +! See http://code.google.com/p/cvmix/ +KPP% +%KPP + +! === module MOM_diffConvection === +! This module implements enhanced diffusivity as a +! function of static stability, N^2. +CONVECTION% +%CONVECTION + +! === module MOM_entrain_diffusive === +MAX_ENT_IT = 20 ! default = 5 + ! The maximum number of iterations that may be used to + ! calculate the interior diapycnal entrainment. +TOLERANCE_ENT = 1.0E-05 ! [m] default = 1.341640786499874E-05 + ! The tolerance with which to solve for entrainment values. + +! === module MOM_kappa_shear === +MAX_RINO_IT = 25 ! [nondim] default = 50 + ! The maximum number of iterations that may be used to + ! estimate the Richardson number driven mixing. + +! === module MOM_mixed_layer === +BULK_RI_ML = 0.05 ! [nondim] + ! The efficiency with which mean kinetic energy released + ! by mechanically forced entrainment of the mixed layer + ! is converted to turbulent kinetic energy. +ABSORB_ALL_SW = True ! [Boolean] default = False + ! If true, all shortwave radiation is absorbed by the + ! ocean, instead of passing through to the bottom mud. +MSTAR = 0.3 ! [units=nondim] default = 1.2 + ! The ratio of the friction velocity cubed to the TKE + ! input to the mixed layer. +TKE_DECAY = 10.0 ! [nondim] default = 2.5 + ! TKE_DECAY relates the vertical rate of decay of the + ! TKE available for mechanical entrainment to the natural + ! Ekman depth. +HMIX_MIN = 2.0 ! [m] default = 0.0 + ! The minimum mixed layer depth if the mixed layer depth + ! is determined dynamically. +LIMIT_BUFFER_DETRAIN = True ! [Boolean] default = False + ! If true, limit the detrainment from the buffer layers + ! to not be too different from the neighbors. +DEPTH_LIMIT_FLUXES = 0.1 ! [m] default = 0.2 + ! The surface fluxes are scaled away when the total ocean + ! depth is less than DEPTH_LIMIT_FLUXES. +CORRECT_ABSORPTION_DEPTH = True ! [Boolean] default = False + ! If true, the depth at which penetrating shortwave + ! radiation is absorbed is corrected by moving some of + ! the heating upward in the water column. + +! === module MOM_regularize_layers === + +! === module MOM_opacity === +PEN_SW_SCALE = 15.0 ! [m] default = 0.0 + ! The vertical absorption e-folding depth of the + ! penetrating shortwave radiation. +PEN_SW_FRAC = 0.42 ! [nondim] default = 0.0 + ! The fraction of the shortwave radiation that penetrates + ! below the surface. + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === +KHTR = 1.0 ! [m2 s-1] default = 0.0 + ! The background along-isopycnal tracer diffusivity. +KHTR_MAX = 900.0 ! [m2 s-1] default = 0.0 + ! The maximum along-isopycnal tracer diffusivity. +ML_KHTR_SCALE = 0.0 ! [nondim] default = 1.0 + ! With Diffuse_ML_interior, the ratio of the truly + ! horizontal diffusivity in the mixed layer to the + ! epipycnal diffusivity. The valid range is 0 to 1. + +! === module MOM_surface_forcing === +BUOY_CONFIG = "linear" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), and (NONE). +WIND_CONFIG = "gyres" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). +TAUX_SIN_AMP = 0.1 ! [Pa] default = 0.0 + ! With the gyres wind_config, the sine amplitude in the + ! zonal wind stress profile: + ! B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +TAUX_N_PIS = 1.0 ! [nondim] default = 0.0 + ! With the gyres wind_config, the number of gyres in + ! the zonal wind stress profile: + ! n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L). +RESTOREBUOY = True ! [Boolean] default = False + ! If true, the buoyancy fluxes drive the model back + ! toward some specified surface state with a rate + ! given by FLUXCONST. +FLUXCONST = 0.5 ! [m day-1] + ! The constant that relates the restoring surface fluxes + ! to the relative surface anomalies (akin to a piston + ! velocity). Note the non-MKS units. +SST_NORTH = 27.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the northern end of the domain toward which to + ! to restore. +SST_SOUTH = 3.0 ! [deg C] default = 0.0 + ! With buoy_config linear, the sea surface temperature + ! at the southern end of the domain toward which to + ! to restore. + +! === module MOM_sum_output === +MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 + ! The run will be stopped, and the day set to a very + ! large value if the velocity is truncated more than + ! MAXTRUNC times between energy saves. Set MAXTRUNC to 0 + ! to stop if there is any truncation of velocities. +MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 + ! The maximum amount of cpu time per processor for which + ! MOM should run before saving a restart file and + ! quitting with a return value that indicates that a + ! further run is required to complete the simulation. + ! If automatic restarts are not desired, use a negative + ! value for MAXCPU. MAXCPU has units of wall-clock + ! seconds, so the actual CPU time used is larger by a + ! factor of the number of processors used. + +! === module MOM_main (MOM_driver) === +DT_FORCING = 10800.0 ! [s] default = 900.0 + ! The time step for changing forcing, coupling with other + ! components, or potentially writing certain diagnostics. + ! The default value is given by DT. +DAYMAX = 1.0 ! [days] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set (as it was here) via ocean_solo_nml in input.nml. +RESTART_CONTROL = 3 ! default = 1 + ! An integer whose bits encode which restart files are + ! written. Add 2 (bit 1) for a time-stamped file, and odd + ! (bit 0) for a non-time-stamped file. A non-time-stamped + ! restart file is saved at the end of the run segment + ! for any non-negative value. +RESTINT = 365.0 ! [days] default = 0.0 + ! The interval between saves of the restart file in units + ! of TIMEUNIT. Use 0 (the default) to not save + ! incremental restart files at all. +ENERGYSAVEDAYS = 0.5 ! [days] default = 3600.0 + ! The interval in units of TIMEUNIT between saves of the + ! energies of the run and other globally summed diagnostics. +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc2/MOM_override b/.testing/tc2/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc2/diag_table b/.testing/tc2/diag_table new file mode 100644 index 0000000000..19d6a32e1e --- /dev/null +++ b/.testing/tc2/diag_table @@ -0,0 +1,86 @@ +"MOM benchmark Experiment" +1 1 1 0 0 0 +"prog", 1,"days",1,"days","time", +#"ave_prog", 5,"days",1,"days","Time",365,"days" +#"cont", 5,"days",1,"days","Time",365,"days" + +#This is the field section of the diag_table. + +# Prognostic Ocean fields: +#========================= + +"ocean_model","u","u","prog","all",.false.,"none",2 +"ocean_model","v","v","prog","all",.false.,"none",2 +"ocean_model","h","h","prog","all",.false.,"none",1 +"ocean_model","e","e","prog","all",.false.,"none",2 +"ocean_model","temp","temp","prog","all",.false.,"none",2 +#"ocean_model","salt","salt","prog","all",.false.,"none",2 + +#"ocean_model","u","u","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","v","v","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h","h","ave_prog_%4yr_%3dy","all",.true.,"none",1 +#"ocean_model","e","e","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +# Auxilary Tracers: +#================== +#"ocean_model","vintage","vintage","prog_%4yr_%3dy","all",.false.,"none",2 +#"ocean_model","age","age","prog_%4yr_%3dy","all",.false.,"none",2 + +# Continuity Equation Terms: +#=========================== +#"ocean_model","dhdt","dhdt","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","wd","wd","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh","uh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh","vh","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","h_rho","h_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uh_rho","uh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vh_rho","vh_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","uhGM_rho","uhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","vhGM_rho","vhGM_rho","cont_%4yr_%3dy","all",.true.,"none",2 + +# +# Tracer Fluxes: +#================== +#"ocean_model","T_adx", "T_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_ady", "T_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffx","T_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","T_diffy","T_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_adx", "S_adx", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_ady", "S_ady", "ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffx","S_diffx","ave_prog_%4yr_%3dy","all",.true.,"none",2 +#"ocean_model","S_diffy","S_diffy","ave_prog_%4yr_%3dy","all",.true.,"none",2 + +#============================================================================================= +# +#===- This file can be used with diag_manager/v2.0a (or higher) ==== +# +# +# FORMATS FOR FILE ENTRIES (not all input values are used) +# ------------------------ +# +#"file_name", output_freq, "output_units", format, "time_units", "time_long_name", ... +# (opt) new_file_frequecy, (opt) "new_file_freq_units", "new_file_start_date" +# +# +#output_freq: > 0 output frequency in "output_units" +# = 0 output frequency every time step +# =-1 output frequency at end of run +# +#output_units = units used for output frequency +# (years, months, days, minutes, hours, seconds) +# +#time_units = units used to label the time axis +# (days, minutes, hours, seconds) +# +# +# FORMAT FOR FIELD ENTRIES (not all input values are used) +# ------------------------ +# +#"module_name", "field_name", "output_name", "file_name" "time_sampling", time_avg, "other_opts", packing +# +#time_avg = .true. or .false. +# +#packing = 1 double precision +# = 2 float +# = 4 packed 16-bit integers +# = 8 packed 1-byte (not tested?) diff --git a/.testing/tc2/input.nml b/.testing/tc2/input.nml new file mode 100644 index 0000000000..54b26920b1 --- /dev/null +++ b/.testing/tc2/input.nml @@ -0,0 +1,19 @@ +&mom_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT/' + restart_output_dir = 'RESTART/' + parameter_filename = + 'MOM_input', + 'MOM_override', +/ + +&diag_manager_nml +/ + +&fms_nml + clock_grain = 'ROUTINE' + clock_flags = 'SYNC' + domains_stack_size = 955296 + stack_size = 0 +/ diff --git a/.testing/tc3/MOM_input b/.testing/tc3/MOM_input new file mode 100644 index 0000000000..1689ef993e --- /dev/null +++ b/.testing/tc3/MOM_input @@ -0,0 +1,471 @@ +/* This input file provides the adjustable run-time parameters for version 6 of + the Modular Ocean Model (MOM6), a numerical ocean model developed at NOAA-GFDL. + Where appropriate, parameters use usually given in MKS units. + + This particular file is for the example in circle_obcs. + + This MOM_input file typically contains only the non-default values that are + needed to reproduce this example. A full list of parameters for this example + can be found in the corresponding MOM_parameter_doc.all file which is + generated by the model at run-time. */ + +REENTRANT_X = False ! [Boolean] default = True + ! If true, the domain is zonally reentrant. +!SYMMETRIC_MEMORY_ = True ! [Boolean] + ! If defined, the velocity point data domain includes + ! every face of the thickness points. In other words, + ! some arrays are larger than others, depending on where + ! they are on the staggered grid. Also, the starting + ! index of the velocity-point arrays is usually 0, not 1. + ! This can only be set at compile time. +!STATIC_MEMORY_ = False ! [Boolean] + ! If STATIC_MEMORY_ is defined, the principle variables + ! will have sizes that are statically determined at + ! compile time. Otherwise the sizes are not determined + ! until run time. The STATIC option is substantially + ! faster, but does not allow the PE count to be changed + ! at run time. This can only be set at compile time. +NIHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! x-direction. With STATIC_MEMORY_ this is set as NIHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NIHALO_ in MOM_memory.h (if defined) or 2. +NJHALO = 4 ! default = 2 + ! The number of halo points on each side in the + ! y-direction. With STATIC_MEMORY_ this is set as NJHALO_ + ! in MOM_memory.h at compile time; without STATIC_MEMORY_ + ! the default is NJHALO_ in MOM_memory.h (if defined) or 2. +NIGLOBAL = 25 ! + ! The total number of thickness grid points in the + ! x-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +NJGLOBAL = 25 ! + ! The total number of thickness grid points in the + ! y-direction in the physical domain. With STATIC_MEMORY_ + ! this is set in MOM_memory.h at compile time. +!NIPROC = 1 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!NJPROC = 2 ! + ! The number of processors in the x-direction. With + ! STATIC_MEMORY_ this is set in MOM_memory.h at compile time. +!LAYOUT = 1, 2 ! + ! The processor layout that was acutally used. +IO_LAYOUT = 1, 1 ! default = 0 + ! The processor layout to be used, or 0,0 to automatically + ! set the io_layout to be the same as the layout. + +! === module MOM_grid === +! Parameters providing information about the vertical grid. +RHO_0 = 1031.0 ! [kg m-3] default = 1035.0 + ! 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. +NK = 10 ! [nondim] + ! The number of model layers. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. + +! === module MOM === +ENABLE_THERMODYNAMICS = False ! [Boolean] default = True + ! If true, Temperature and salinity are used as state + ! variables. +DT = 120.0 ! [s] + ! The (baroclinic) dynamics time step. The time-step that + ! is actually used will be an integer fraction of the + ! forcing time-step (DT_FORCING in ocean-only mode or the + ! coupling timestep in coupled mode.) +DTBT_RESET_PERIOD = -1.0 ! [s] default = 120.0 + ! The period between recalculations of DTBT (if DTBT <= 0). + ! If DTBT_RESET_PERIOD is negative, DTBT is set based + ! only on information available at initialization. If + ! dynamic, DTBT will be set at least every forcing time + ! step, and if 0, every dynamics time step. The default is + ! set by DT_THERM. This is only used if SPLIT is true. +SAVE_INITIAL_CONDS = True ! [Boolean] default = False + ! If true, write the initial conditions to a file given + ! by IC_OUTPUT_FILE. +IC_OUTPUT_FILE = "GOLD_IC" ! default = "MOM_IC" + ! The file into which to write the initial conditions. + +! === module MOM_tracer_registry === + +! === module MOM_tracer_flow_control === +USE_DOME_TRACER = True ! [Boolean] default = False + ! If true, use the DOME_tracer tracer package. + +! === module DOME_tracer === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. +COORD_CONFIG = "layer_ref" ! + ! This specifies how layers are to be defined: + ! file - read coordinate information from the file + ! specified by (COORD_FILE). + ! linear - linear based on interfaces not layesrs. + ! ts_ref - use reference temperature and salinity + ! ts_range - use range of temperature and salinity + ! (T_REF and S_REF) to determine surface density + ! and GINT calculate internal densities. + ! gprime - use reference density (RHO_0) for surface + ! density and GINT calculate internal densities. + ! ts_profile - use temperature and salinity profiles + ! (read from COORD_FILE) to set layer densities. + ! USER - call a user modified routine. +LIGHTEST_DENSITY = 1030.0 ! [kg m-3] default = 1031.0 + ! The reference potential density used for layer 1. + +! === module MOM_grid_init === +GRID_CONFIG = "cartesian" ! + ! A character string that determines the method for + ! defining the horizontal grid. Current options are: + ! mosaic - read the grid from a mosaic (supergrid) + ! file set by GRID_FILE. + ! cartesian - use a (flat) Cartesian grid. + ! spherical - use a simple spherical grid. + ! mercator - use a Mercator spherical grid. +AXIS_UNITS = "k" ! default = "degrees" + ! The units for the Cartesian axes. Valid entries are: + ! degrees - degrees of latitude and longitude + ! m - meters + ! k - kilometers +SOUTHLAT = 0.0 ! [k] + ! The southern latitude of the domain or the equivalent + ! starting value for the y-axis. +LENLAT = 100.0 ! [k] + ! The latitudinal or y-direction length of the domain. +LENLON = 100.0 ! [k] + ! The longitudinal or x-direction length of the domain. +TOPO_CONFIG = "flat" ! + ! This specifies how bathymetry is specified: + ! file - read bathymetric information from the file + ! specified by (TOPO_FILE). + ! flat - flat bottom set to MAXIMUM_DEPTH. + ! bowl - an analytically specified bowl-shaped basin + ! ranging between MAXIMUM_DEPTH and MINIMUM_DEPTH. + ! spoon - a similar shape to 'bowl', but with an vertical + ! wall at the southern face. + ! halfpipe - a zonally uniform channel with a half-sine + ! profile in the meridional direction. + ! benchmark - use the benchmark test case topography. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! DOME2D - use a shelf and slope configuration for the + ! DOME2D gravity current/overflow test case. + ! seamount - Gaussian bump for spontaneous motion test case. + ! USER - call a user modified routine. +MINIMUM_DEPTH = 1.0 ! [m] default = 0.0 + ! The minimum depth of the ocean. +MAXIMUM_DEPTH = 600.0 ! [m] + ! The maximum depth of the ocean. +! === module MOM_open_boundary === +! Controls where open boundaries are located, what kind of boundary condition to impose, and what data to apply, if any. +OBC_NUMBER_OF_SEGMENTS = 4 ! default = 0 + ! The number of open boundary segments. +OBC_FREESLIP_VORTICITY = True ! [Boolean] default = False + ! If true, sets the normal gradient of tangential velocity to + ! zero in the relative vorticity on open boundaries. This cannot + ! be true if OBC_ZERO_VORTICITY is True. +OBC_FREESLIP_STRAIN = True ! [Boolean] default = False + ! If true, sets the normal gradient of tangential velocity to + ! zero in the strain use in the stress tensor on open boundaries. This cannot + ! be true if OBC_ZERO_STRAIN is True. +OBC_ZERO_BIHARMONIC = True ! [Boolean] default = False + ! If true, zeros the Laplacian of flow on open boundaries in the biharmonic + ! viscosity term. +OBC_SEGMENT_001 = "J=N,I=N:0,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_002 = "J=0,I=0:N,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_003 = "I=N,J=0:N,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_004 = "I=0,J=N:0,FLATHER,ORLANSKI" ! + ! Documentation needs to be dynamic????? +OBC_SEGMENT_001_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" +OBC_SEGMENT_002_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" +OBC_SEGMENT_003_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" +OBC_SEGMENT_004_DATA = "U=value:0.0,V=value:0.0,SSH=value:0.0" + +ROTATION = "beta" ! default = "2omegasinlat" + ! This specifies how the Coriolis parameter is specified: + ! 2omegasinlat - Use twice the planetary rotation rate + ! times the sine of latitude. + ! betaplane - Use a beta-plane or f-plane. + ! USER - call a user modified routine. +THICKNESS_CONFIG = "circle_obcs" ! + ! A string that determines how the initial layer + ! thicknesses are specified for a new run: + ! file - read interface heights from the file specified + ! thickness_file - read thicknesses from the file specified + ! by (THICKNESS_FILE). + ! uniform - uniform thickness layers evenly distributed + ! between the surface and MAXIMUM_DEPTH. + ! DOME - use a slope and channel configuration for the + ! DOME sill-overflow test case. + ! benchmark - use the benchmark test case thicknesses. + ! search - search a density profile for the interface + ! densities. This is not yet implemented. + ! circle_obcs - the circle_obcs test case is used. + ! DOME2D - 2D version of DOME initialization. + ! adjustment2d - TBD AJA. + ! sloshing - TBD AJA. + ! seamount - TBD AJA. + ! USER - call a user modified routine. + +! === module circle_obcs_initialize_thickness === +DISK_RADIUS = 24.0 ! [k] + ! The radius of the initially elevated disk in the + ! circle_obcs test case. + +! === module MOM_MEKE === +CDRAG = 0.002 ! [nondim] default = 0.003 + ! CDRAG is the drag coefficient relating the magnitude of + ! the velocity field to the bottom stress. + +! === module MOM_lateral_mixing_coeffs === +BOUND_CORIOLIS = True ! [Boolean] default = False + ! If true, the Coriolis terms at u-points are bounded by + ! the four estimates of (f+rv)v from the four neighboring + ! v-points, and similarly at v-points. This option would + ! have no effect on the SADOURNY Coriolis scheme if it + ! were possible to use centered difference thickness fluxes. + +! === module MOM_hor_visc === +LAPLACIAN = True ! [Boolean] default = False + ! If true, use a Laplacian horizontal viscosity. +KH = 25.0 ! [m2 s-1] default = 0.0 + ! The background Laplacian horizontal viscosity. +KH_VEL_SCALE = 0.003 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the grid + ! spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and KH. +SMAGORINSKY_KH = True ! [Boolean] default = False + ! If true, use a Smagorinsky nonlinear eddy viscosity. +SMAG_LAP_CONST = 0.15 ! [nondim] default = 0.0 + ! The nondimensional Laplacian Smagorinsky constant, + ! often 0.15. +AH_VEL_SCALE = 0.003 ! [m s-1] default = 0.0 + ! The velocity scale which is multiplied by the cube of + ! the grid spacing to calculate the Laplacian viscosity. + ! The final viscosity is the largest of this scaled + ! viscosity, the Smagorinsky viscosity and AH. +SMAGORINSKY_AH = True ! [Boolean] default = False + ! If true, use a biharmonic Smagorinsky nonlinear eddy + ! viscosity. +SMAG_BI_CONST = 0.06 ! [nondim] default = 0.0 + ! The nondimensional biharmonic Smagorinsky constant, + ! typically 0.015 - 0.06. + +! === module MOM_vert_friction === +DIRECT_STRESS = True ! [Boolean] default = False + ! If true, the wind stress is distributed over the + ! topmost HMIX_STRESS of fluid (like in HYCOM), and KVML + ! may be set to a very small value. +U_TRUNC_FILE = "U_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to zonal velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +V_TRUNC_FILE = "V_velocity_truncations" ! default = "" + ! The absolute path to a file into which the accelerations + ! leading to meridional velocity truncations are written. + ! Undefine this for efficiency if this diagnostic is not + ! needed. +HARMONIC_VISC = True ! [Boolean] default = False + ! If true, use the harmonic mean thicknesses for + ! calculating the vertical viscosity. +HMIX_FIXED = 20.0 ! [m] + ! The prescribed depth over which the near-surface + ! viscosity and diffusivity are elevated when the bulk + ! mixed layer is not used. +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. +HBBL = 10.0 ! [m] + ! The thickness of a bottom boundary layer with a + ! viscosity of KVBBL 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. +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity + ! components are truncated. + +! === module MOM_PointAccel === + +! === module MOM_set_visc === +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) + ! shear mixing parameterization. +DRAG_BG_VEL = 0.05 ! [m s-1] default = 0.0 + ! DRAG_BG_VEL is either the assumed bottom velocity (with + ! LINEAR_DRAG) or an unresolved velocity that is + ! combined with the resolved velocity to estimate the + ! velocity magnitude. DRAG_BG_VEL is only used when + ! BOTTOMDRAGLAW is defined. +BBL_THICK_MIN = 0.1 ! [m] default = 0.0 + ! 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 + ! near-bottom viscosity. + +! === module MOM_barotropic === +BOUND_BT_CORRECTION = True ! [Boolean] default = False + ! If true, the corrective pseudo mass-fluxes into the + ! barotropic solver are limited to values that require + ! less than 0.1*MAXVEL to be accommodated. +!BT x-halo = 0 ! + ! The barotropic x-halo size that is actually used. +!BT y-halo = 0 ! + ! The barotropic y-halo size that is actually used. +NONLINEAR_BT_CONTINUITY = True ! [Boolean] default = False + ! If true, use nonlinear transports in the barotropic + ! continuity equation. This does not apply if + ! USE_BT_CONT_TYPE is true. +BT_PROJECT_VELOCITY = True ! [Boolean] default = False + ! If true, step the barotropic velocity first and project + ! out the velocity tendancy by 1+BEBT when calculating the + ! transport. The default (false) is to use a predictor + ! continuity step to find the pressure field, and then + ! to do a corrector continuity step using a weighted + ! average of the old and new velocities, with weights + ! of (1-BEBT) and BEBT. +BT_THICK_SCHEME = "FROM_BT_CONT" ! default = "HYBRID" + ! A string describing the scheme that is used to set the + ! open face areas used for barotropic transport and the + ! relative weights of the accelerations. Valid values are: + ! ARITHMETIC - arithmetic mean layer thicknesses + ! HARMONIC - harmonic mean layer thicknesses + ! HYBRID (the default) - use arithmetic means for + ! layers above the shallowest bottom, the harmonic + ! mean for layers below, and a weighted average for + ! layers that straddle that depth + ! FROM_BT_CONT - use the average thicknesses kept + ! in the h_u and h_v fields of the BT_cont_type +BT_STRONG_DRAG = False ! [Boolean] default = True + ! If true, use a stronger estimate of the retarding + ! effects of strong bottom drag, by making it implicit + ! with the barotropic time-step instead of implicit with + ! the baroclinic time-step and dividing by the number of + ! barotropic steps. +BEBT = 0.2 ! [nondim] default = 0.1 + ! BEBT determines whether the barotropic time stepping + ! uses the forward-backward time-stepping scheme or a + ! backward Euler scheme. BEBT is valid in the range from + ! 0 (for a forward-backward treatment of nonrotating + ! gravity waves) to 1 (for a backward Euler treatment). + ! In practice, BEBT must be greater than about 0.05. +DTBT = -0.95 ! [s or nondim] default = -0.98 + ! The barotropic time step, in s. DTBT is only used with + ! the split explicit time stepping. To set the time step + ! automatically based the maximum stable value use 0, or + ! a negative value gives the fraction of the stable value. + ! Setting DTBT to 0 is the same as setting it to -0.98. + ! The value of DTBT that will actually be used is an + ! integer fraction of DT, rounding down. + +! === module MOM_thickness_diffuse === + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. +KD = 1.0E-04 ! [m2 s-1] + ! The background diapycnal diffusivity of density in the + ! interior. Zero or the molecular value, ~1e-7 m2 s-1, + ! may be used. + +! === module MOM_KPP === +! This is the MOM wrapper to CVmix:KPP +! See http://code.google.com/p/cvmix/ +KPP% +%KPP + +! === module MOM_diffConvection === +! This module implements enhanced diffusivity as a +! function of static stability, N^2. +CONVECTION% +%CONVECTION + +! === module MOM_entrain_diffusive === +MAX_ENT_IT = 20 ! default = 5 + ! The maximum number of iterations that may be used to + ! calculate the interior diapycnal entrainment. +TOLERANCE_ENT = 1.0E-05 ! [m] default = 1.095445115010332E-05 + ! The tolerance with which to solve for entrainment values. + +! === module MOM_kappa_shear === +MAX_RINO_IT = 25 ! [nondim] default = 50 + ! The maximum number of iterations that may be used to + ! estimate the Richardson number driven mixing. + +! === module MOM_regularize_layers === + +! === module MOM_tracer_advect === + +! === module MOM_tracer_hor_diff === + +! === module MOM_surface_forcing === +VARIABLE_WINDS = False ! [Boolean] default = True + ! If true, the winds vary in time after the initialization. +VARIABLE_BUOYFORCE = False ! [Boolean] default = True + ! If true, the buoyancy forcing varies in time after the + ! initialization of the model. +BUOY_CONFIG = "zero" ! + ! The character string that indicates how buoyancy forcing + ! is specified. Valid options include (file), (zero), + ! (linear), (USER), and (NONE). +WIND_CONFIG = "zero" ! + ! The character string that indicates how wind forcing + ! is specified. Valid options include (file), (2gyre), + ! (1gyre), (gyres), (zero), and (USER). + +! === module MOM_sum_output === +MAXTRUNC = 10 ! [truncations save_interval-1] default = 0 + ! The run will be stopped, and the day set to a very + ! large value if the velocity is truncated more than + ! MAXTRUNC times between energy saves. Set MAXTRUNC to 0 + ! to stop if there is any truncation of velocities. +DATE_STAMPED_STDOUT = False ! [Boolean] default = True + ! If true, use dates (not times) in messages to stdout +TIMEUNIT = 120.0 ! [s] default = 8.64E+04 + ! The time unit in seconds a number of input fields +MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 + ! The maximum amount of cpu time per processor for which + ! MOM should run before saving a restart file and + ! quitting with a return value that indicates that a + ! further run is required to complete the simulation. + ! If automatic restarts are not desired, use a negative + ! value for MAXCPU. MAXCPU has units of wall-clock + ! seconds, so the actual CPU time used is larger by a + ! factor of the number of processors used. + +! === module MOM_main (MOM_driver) === +DT_FORCING = 360.0 ! [s] default = 120.0 + ! The time step for changing forcing, coupling with other + ! components, or potentially writing certain diagnostics. + ! The default value is given by DT. +DAYMAX = 6.0 ! [hours] + ! The final time of the whole simulation, in units of + ! TIMEUNIT seconds. This also sets the potential end + ! time of the present run segment if the end time is + ! not set (as it was here) via ocean_solo_nml in input.nml. +RESTART_CONTROL = 3 ! default = 1 + ! An integer whose bits encode which restart files are + ! written. Add 2 (bit 1) for a time-stamped file, and odd + ! (bit 0) for a non-time-stamped file. A non-time-stamped + ! restart file is saved at the end of the run segment + ! for any non-negative value. +RESTINT = 10.0 ! [hours] default = 0.0 + ! The interval between saves of the restart file in units + ! of TIMEUNIT. Use 0 (the default) to not save + ! incremental restart files at all. +ENERGYSAVEDAYS = 3.0 ! [hours] default = 1.44E+04 + ! The interval in units of TIMEUNIT between saves of the + ! energies of the run and other globally summed diagnostics. +DIAG_AS_CHKSUM = True +DEBUG = True diff --git a/.testing/tc3/MOM_override b/.testing/tc3/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/tc3/diag_table b/.testing/tc3/diag_table new file mode 100644 index 0000000000..e31244cbd4 --- /dev/null +++ b/.testing/tc3/diag_table @@ -0,0 +1,207 @@ +"MOM Experiment" +1 1 1 0 0 0 +"prog", 2,"minutes",1,"days","Time", +#"ave_prog", 1,"hours",1,"days","Time", +#"cont", 1,"hours",1,"days","Time", +#"trac", 5,"days",1,"days","Time", +#"mom", 5,"days",1,"days","Time", +#"bt_mom", 5,"days",1,"days","Time", +#"visc", 5,"days",1,"days","Time", +#"energy", 5,"days",1,"days","Time", +#"ML_TKE", 5,"days",1,"days","Time", +#"forcing", 5,"days",1,"days","Time", + +#This is the field section of the diag_table. + +# Prognostic Ocean fields: +#========================= + +"ocean_model","u","u","prog","all",.false.,"none",2 +"ocean_model","v","v","prog","all",.false.,"none",2 +"ocean_model","h","h","prog","all",.false.,"none",1 +"ocean_model","e","e","prog","all",.false.,"none",2 +#"ocean_model","SSH","SSH","prog","all",.false.,"none",2 +#"ocean_model","temp","temp","prog","all",.false.,"none",2 +#"ocean_model","salt","salt","prog","all",.false.,"none",2 +#"ocean_model","Rml","Rml","prog","all",.false.,"none",2 +#"ocean_model","tr_D1","tr1","prog","all",.false.,"none",2 + +#"ocean_model","RV","RV","prog","all",.false.,"none",2 +#"ocean_model","PV","PV","prog","all",.false.,"none",2 +#"ocean_model","e_D","e_D","prog","all",.false.,"none",2 + +#"ocean_model","u","u","ave_prog","all",.true.,"none",2 +#"ocean_model","v","v","ave_prog","all",.true.,"none",2 +#"ocean_model","h","h","ave_prog","all",.true.,"none",1 +#"ocean_model","e","e","ave_prog","all",.true.,"none",2 +#"ocean_model","temp","temp","ave_prog","all",.true.,"none",2 +#"ocean_model","salt","salt","ave_prog","all",.true.,"none",2 +#"ocean_model","Rml","Rml","ave_prog","all",.true.,"none",2 + +# Auxilary Tracers: +#================== +#"ocean_model","vintage","vintage","prog","all",.false.,"none",2 +#"ocean_model","age","age","prog","all",.false.,"none",2 + +# Tracers: +#========= +#"ocean_model","tr_D1","tr1","trac","all",.false.,"none",2 +#"ocean_model","tr_D2","tr2","trac","all",.false.,"none",2 +#"ocean_model","tr_D3","tr3","trac","all",.false.,"none",2 +#"ocean_model","tr_D4","tr4","trac","all",.false.,"none",2 +#"ocean_model","tr_D5","tr5","trac","all",.false.,"none",2 +#"ocean_model","tr_D6","tr6","trac","all",.false.,"none",2 +#"ocean_model","tr_D7","tr7","trac","all",.false.,"none",2 +#"ocean_model","tr_D8","tr8","trac","all",.false.,"none",2 +#"ocean_model","tr_D9","tr9","trac","all",.false.,"none",2 +#"ocean_model","tr_D10","tr10","trac","all",.false.,"none",2 +#"ocean_model","tr_D11","tr11","trac","all",.false.,"none",2 + +# Continuity Equation Terms: +#=========================== +#"ocean_model","dhdt","dhdt","cont","all",.true.,"none",2 +#"ocean_model","wd","wd","cont","all",.true.,"none",2 +#"ocean_model","uh","uh","cont","all",.true.,"none",2 +#"ocean_model","vh","vh","cont","all",.true.,"none",2 +#"ocean_model","uhGM","uhGM","cont","all",.true.,"none",2 +#"ocean_model","vhGM","vhGM","cont","all",.true.,"none",2 +#"ocean_model","uhbt","uhbt","cont","all",.true.,"none",2 +#"ocean_model","vhbt","vhbt","cont","all",.true.,"none",2 + +# Continuity Equation Terms In Pure Potential Density Coordiantes: +#================================================================= +#"ocean_model","h_rho","h_rho","cont","all",.true.,"none",2 +#"ocean_model","uh_rho","uh_rho","cont","all",.true.,"none",2 +#"ocean_model","vh_rho","vh_rho","cont","all",.true.,"none",2 +#"ocean_model","uhGM_rho","uhGM_rho","cont","all",.true.,"none",2 +#"ocean_model","vhGM_rho","vhGM_rho","cont","all",.true.,"none",2 + +# +# Tracer Fluxes: +#================== +#"ocean_model","T_adx", "T_adx", "ave_prog","all",.true.,"none",2 +#"ocean_model","T_ady", "T_ady", "ave_prog","all",.true.,"none",2 +#"ocean_model","T_diffx","T_diffx","ave_prog","all",.true.,"none",2 +#"ocean_model","T_diffy","T_diffy","ave_prog","all",.true.,"none",2 +#"ocean_model","S_adx", "S_adx", "ave_prog","all",.true.,"none",2 +#"ocean_model","S_ady", "S_ady", "ave_prog","all",.true.,"none",2 +#"ocean_model","S_diffx","S_diffx","ave_prog","all",.true.,"none",2 +#"ocean_model","S_diffy","S_diffy","ave_prog","all",.true.,"none",2 + + +# Momentum Balance Terms: +#======================= +#"ocean_model","dudt","dudt","mom","all",.true.,"none",2 +#"ocean_model","dvdt","dvdt","mom","all",.true.,"none",2 +#"ocean_model","CAu","CAu","mom","all",.true.,"none",2 +#"ocean_model","CAv","CAv","mom","all",.true.,"none",2 +#"ocean_model","PFu","PFu","mom","all",.true.,"none",2 +#"ocean_model","PFv","PFv","mom","all",.true.,"none",2 +#"ocean_model","du_dt_visc","du_dt_visc","mom","all",.true.,"none",2 +#"ocean_model","dv_dt_visc","dv_dt_visc","mom","all",.true.,"none",2 +#"ocean_model","diffu","diffu","mom","all",.true.,"none",2 +#"ocean_model","diffv","diffv","mom","all",.true.,"none",2 +#"ocean_model","dudt_dia","dudt_dia","mom","all",.true.,"none",2 +#"ocean_model","dvdt_dia","dvdt_dia","mom","all",.true.,"none",2 +# Subterms that should not be added to a closed budget. +#"ocean_model","gKEu","gKEu","mom","all",.true.,"none",2 +#"ocean_model","gKEv","gKEv","mom","all",.true.,"none",2 +#"ocean_model","rvxu","rvxu","mom","all",.true.,"none",2 +#"ocean_model","rvxv","rvxv","mom","all",.true.,"none",2 +#"ocean_model","PFu_bc","PFu_bc","mom","all",.true.,"none",2 +#"ocean_model","PFv_bc","PFv_bc","mom","all",.true.,"none",2 + +# Barotropic Momentum Balance Terms: +# (only available with split time stepping.) +#=========================================== +#"ocean_model","PFuBT","PFuBT","bt_mom","all",.true.,"none",2 +#"ocean_model","PFvBT","PFvBT","bt_mom","all",.true.,"none",2 +#"ocean_model","CoruBT","CoruBT","bt_mom","all",.true.,"none",2 +#"ocean_model","CorvBT","CorvBT","bt_mom","all",.true.,"none",2 +#"ocean_model","ubtforce","ubtforce","bt_mom","all",.true.,"none",2 +#"ocean_model","vbtforce","vbtforce","bt_mom","all",.true.,"none",2 +#"ocean_model","u_accel_bt","u_accel_bt","bt_mom","all",.true.,"none",2 +#"ocean_model","v_accel_bt","v_accel_bt","bt_mom","all",.true.,"none",2 +# +# Viscosities and diffusivities: +#=============================== +#"ocean_model","Kd_effective","Kd_effective","visc","all",.true.,"none",2 +#"ocean_model","Ahh","Ahh","visc","all",.true.,"none",2 +#"ocean_model","Ahq","Ahq","visc","all",.true.,"none",2 +#"ocean_model","Khh","Khh","visc","all",.true.,"none",2 +#"ocean_model","Khq","Khq","visc","all",.true.,"none",2 +#"ocean_model","bbl_thick_u","bbl_thick_u","visc","all",.true.,"none",2 +#"ocean_model","kv_bbl_u","kv_bbl_u","visc","all",.true.,"none",2 +#"ocean_model","bbl_thick_v","bbl_thick_v","visc","all",.true.,"none",2 +#"ocean_model","kv_bbl_v","kv_bbl_v","visc","all",.true.,"none",2 +#"ocean_model","av_visc","av_visc","visc","all",.true.,"none",2 +#"ocean_model","au_visc","au_visc","visc","all",.true.,"none",2 +# +# Kinetic Energy Balance Terms: +#============================= +#"ocean_model","KE","KE","energy","all",.true.,"none",2 +#"ocean_model","dKE_dt","dKE_dt","energy","all",.true.,"none",2 +#"ocean_model","PE_to_KE","PE_to_KE","energy","all",.true.,"none",2 +#"ocean_model","KE_Coradv","KE_Coradv","energy","all",.true.,"none",2 +#"ocean_model","KE_adv","KE_adv","energy","all",.true.,"none",2 +#"ocean_model","KE_visc","KE_visc","energy","all",.true.,"none",2 +#"ocean_model","KE_horvisc","KE_horvisc","energy","all",.true.,"none",2 +#"ocean_model","KE_dia","KE_dia","energy","all",.true.,"none",2 +# +# Mixed Layer TKE Budget Terms: +#=========================== +#"ocean_model","TKE_wind","TKE_wind","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_RiBulk","TKE_RiBulk","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_conv","TKE_conv","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_pen_SW","TKE_pen_SW","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_mixing","TKE_mixing","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_mech_decay","TKE_mech_decay","ML_TKE","all",.true.,"none",2 +#"ocean_model","TKE_conv_decay","TKE_conv_decay","ML_TKE","all",.true.,"none",2 + +# Surface Forcing: +#================= +#"ocean_model","taux","taux","forcing","all",.true.,"none",2 +#"ocean_model","tauy","tauy","forcing","all",.true.,"none",2 +#"ocean_model","ustar","ustar","forcing","all",.true.,"none",2 +#"ocean_model","PRCmE","PRCmE","forcing","all",.true.,"none",2 +#"ocean_model","SW","SW","forcing","all",.true.,"none",2 +#"ocean_model","LwLatSens","LwLatSens","forcing","all",.true.,"none",2 +#"ocean_model","p_surf","p_surf","forcing","all",.true.,"none",2 +#"ocean_model","salt_flux","salt_flux","forcing","all",.true.,"none",2 +# + + +#============================================================================================= +# +#====> This file can be used with diag_manager/v2.0a (or higher) <==== +# +# +# FORMATS FOR FILE ENTRIES (not all input values are used) +# ------------------------ +# +#"file_name", output_freq, "output_units", format, "time_units", "time_long_name", ... +# (opt) new_file_frequecy, (opt) "new_file_freq_units", "new_file_start_date" +# +# +#output_freq: > 0 output frequency in "output_units" +# = 0 output frequency every time step +# =-1 output frequency at end of run +# +#output_units = units used for output frequency +# (years, months, days, minutes, hours, seconds) +# +#time_units = units used to label the time axis +# (days, minutes, hours, seconds) +# +# +# FORMAT FOR FIELD ENTRIES (not all input values are used) +# ------------------------ +# +#"module_name", "field_name", "output_name", "file_name" "time_sampling", time_avg, "other_opts", packing +# +#time_avg = .true. or .false. +# +#packing = 1 double precision +# = 2 float +# = 4 packed 16-bit integers +# = 8 packed 1-byte (not tested?) diff --git a/.testing/tc3/input.nml b/.testing/tc3/input.nml new file mode 100644 index 0000000000..e9aa67941d --- /dev/null +++ b/.testing/tc3/input.nml @@ -0,0 +1,17 @@ +&MOM_input_nml + output_directory = './' + input_filename = 'n' + restart_input_dir = 'INPUT' + restart_output_dir = 'RESTART/' + parameter_filename = + 'MOM_input', + 'MOM_override' +/ + +&diag_manager_nml +/ + +&fms_nml + domains_stack_size = 1326000 + stack_size = 0 +/ diff --git a/.travis.yml b/.travis.yml index 1d200d1899..41d9d9b348 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,6 +5,11 @@ language: c dist: xenial +# --depth flag is breaking our merge, try disabling it +# NOTE: We may be able to go back to depth=50 in production +git: + depth: false + addons: apt: sources: @@ -13,99 +18,30 @@ addons: - tcsh pkg-config netcdf-bin libnetcdf-dev libnetcdff-dev openmpi-bin libopenmpi-dev gfortran - doxygen graphviz flex bison cmake -# Stages occur sequentially. Within each stage jobs run concurrently. -stages: - - check and compile - - tests - - cleanup - -cache: - directories: - - build - -# Compilation and testing is controlled by the "configure" and "Makefile" in -# .testing/ but they operate from the root directory. We copy them into place -# so that they can remain hidden from users. -install: - - echo "Install step" - - cp .testing/{configure,Makefile} . - -before_script: - - ls -l - - ls build - -# This avoids caching files we do not need between stages -before_cache: - - rm -f build/*.o build/*.mod - jobs: include: - - # Checks and compilation ################################################### -# - stage: check and compile -# script: -# - echo "Blank environment - this is where we would compile if we wanted to reuse executables in multiple tests" -# #- touch build/comp_nothing - - stage: check and compile - env: JOB="Code style compliance" - script: - - ./.testing/trailer.py -e TEOS10 -l 120 src config_src - - stage: check and compile - env: JOB="Doxygen" + - env: JOB="Code style compliance" script: - - cd docs && doxygen Doxyfile_nortd - - grep -v "config_src/solo_driver/coupler_types.F90" doxygen.log | tee doxy_errors - - test ! -s doxy_errors - - &compile-code - stage: check and compile - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" + - ./.testing/trailer.py -e TEOS10 -l 120 src config_src + - env: JOB="Doxygen" script: - - make $MAKEARGS compile - - touch build/comp_${MAKEARGS//\ /_} - - <<: *compile-code - env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" - - <<: *compile-code - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" - - <<: *compile-code - env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" -# - <<: *compile-code -# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" - - # Run tests ################################################################ - # The default "test" job is automatically invoked for each of the matrix environments - # The "test" jobs executes "./configure && make && make test" -# - stage: tests -# script: -# - echo "Placeholder for generic text using blank environment" - - &compile - stage: tests - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" - script: - - ./configure && make -j && make test - - <<: *compile - env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" - - <<: *compile - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" - - <<: *compile - env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" -# - <<: *compile -# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" - - # Clean up ################################################################# - # We only want the cache directory to exist between stages so we manually - # clean out the cache, i.e. build/ - - &clean-build - stage: cleanup + - cd docs && doxygen Doxyfile_nortd + - grep -v "config_src/solo_driver/coupler_types.F90" doxygen.log | tee doxy_errors + - test ! -s doxy_errors + - env: JOB="Compile and run" script: - - rm -rf build/* - - ls -l -# - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric REPRO=1" - - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic REPRO=1" - - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric DEBUG=1" - - <<: *clean-build - env: MAKEARGS="MEMORY_SHAPE=dynamic DEBUG=1" -# - <<: *clean-build -# env: MAKEARGS="MEMORY_SHAPE=dynamic_symmetric OPENMP=1" + - echo 'Build executables...' && echo -en 'travis_fold:start:script.1\\r' + - TRAVIS_IS_PR=$( [ ${TRAVIS_PULL_REQUEST} = "false" ] || echo "true" ) + - cd .testing + - make \ + MKMF_TEMPLATE=linux-ubuntu-xenial-gnu.mk \ + MOM_TARGET_SLUG=${TRAVIS_REPO_SLUG} \ + MOM_TARGET_LOCAL_BRANCH=${TRAVIS_BRANCH} \ + DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ + REPORT_COVERAGE=true + - echo -en 'travis_fold:end:script.1\\r' + - echo 'Running tests...' && echo -en 'travis_fold:start:script.2\\r' + - make test \ + DO_REGRESSION_TESTS=${TRAVIS_IS_PR} \ + REPORT_COVERAGE=true + - echo -en 'travis_fold:end:script.2\\r' diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 similarity index 88% rename from config_src/coupled_driver/MOM_surface_forcing.F90 rename to config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 index 5112a0b64b..4102bba491 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing_gfdl.F90 @@ -1,10 +1,10 @@ -module MOM_surface_forcing +module MOM_surface_forcing_gfdl ! This file is part of MOM6. See LICENSE.md for the license. -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS +!#CTRL# use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts +!#CTRL# use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end +!#CTRL# use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface !! deflections (especially surface gravity waves). The default is false. + real :: G_Earth !< Gravitational acceleration [m s-2] real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions [m2 s-1] - real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert + real :: density_sea_ice !< Typical density of sea-ice [kg m-3]. The value is only used to convert !! the ice pressure into appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which sea-ice viscosity !! becomes effective [kg m-2], typically of order 1000 kg m-2. @@ -126,6 +127,10 @@ module MOM_surface_forcing real :: max_delta_srestore !< Maximum delta salinity used for restoring real :: max_delta_trestore !< Maximum delta sst used for restoring real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + 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. + logical :: check_no_land_fluxes !< Return warning if IOB flux over land is non-zero type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing character(len=200) :: inputdir !< Directory where NetCDF input files are @@ -148,7 +153,7 @@ module MOM_surface_forcing type(forcing_diags), public :: handles !< Diagnostics handles -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions end type surface_forcing_CS @@ -226,7 +231,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc PmE_adj, & ! The adjustment to PminusE that will cause the salinity ! to be restored toward its target value [kg m-1 s-1] net_FW, & ! The area integrated net freshwater flux into the ocean [kg s-1] - net_FW2, & ! The area integrated net freshwater flux into the ocean [kg s-1] + net_FW2, & ! The net freshwater flux into the ocean [kg m-2 s-1] work_sum, & ! A 2-d array that is used as the work space for global sums [m2] or [kg s-1] open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria [nondim] @@ -293,7 +298,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc 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) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo ; enddo if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -323,7 +328,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -355,7 +360,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -376,7 +381,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -402,41 +407,77 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie - if (associated(IOB%lprec)) & + if (associated(IOB%lprec)) then fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%lprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lprec', G) + endif - if (associated(IOB%fprec)) & + if (associated(IOB%fprec)) then fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) + endif - if (associated(IOB%q_flux)) & + if (associated(IOB%q_flux)) then fluxes%evap(i,j) = - IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%q_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'q_flux', G) + endif - if (associated(IOB%runoff)) & + if (associated(IOB%runoff)) then fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%runoff(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff', G) + endif - if (associated(IOB%calving)) & + if (associated(IOB%calving)) then fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%calving(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving', G) + endif - if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%ustar_berg)) then + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%ustar_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'ustar_berg', G) + endif - if (associated(IOB%area_berg)) & + if (associated(IOB%area_berg)) then fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%area_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'area_berg', G) + endif - if (associated(IOB%mass_berg)) & + if (associated(IOB%mass_berg)) then fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%mass_berg(i-i0,j-j0), G%mask2dT(i,j), i, j, 'mass_berg', G) + endif - if (associated(IOB%runoff_hflx)) & + if (associated(IOB%runoff_hflx)) then fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%runoff_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'runoff_hflx', G) + endif - if (associated(IOB%calving_hflx)) & + if (associated(IOB%calving_hflx)) then fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%calving_hflx(i-i0,j-j0), G%mask2dT(i,j), i, j, 'calving_hflx', G) + endif - if (associated(IOB%lw_flux)) & + if (associated(IOB%lw_flux)) then fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%lw_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'lw_flux', G) + endif - if (associated(IOB%t_flux)) & + if (associated(IOB%t_flux)) then fluxes%sens(i,j) = - IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%t_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 't_flux', G) + endif fluxes%latent(i,j) = 0.0 if (associated(IOB%fprec)) then @@ -454,14 +495,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc fluxes%latent(i,j) = G%mask2dT(i,j) * fluxes%latent(i,j) - if (associated(IOB%sw_flux_vis_dir)) & + if (associated(IOB%sw_flux_vis_dir)) then fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) - if (associated(IOB%sw_flux_vis_dif)) & + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_vis_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dir', G) + endif + if (associated(IOB%sw_flux_vis_dif)) then fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) - if (associated(IOB%sw_flux_nir_dir)) & + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_vis_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_vis_dif', G) + endif + if (associated(IOB%sw_flux_nir_dir)) then fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) - if (associated(IOB%sw_flux_nir_dif)) & + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_nir_dir(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dir', G) + endif + if (associated(IOB%sw_flux_nir_dif)) then fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%sw_flux_nir_dif(i-i0,j-j0), G%mask2dT(i,j), i, j, 'sw_flux_nir_dif', G) + endif fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) @@ -473,11 +526,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo else do j=js,je ; do i=is,ie fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%p(i-i0,j-j0), G%mask2dT(i,j), i, j, 'p', G) enddo ; enddo endif fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. @@ -488,18 +545,20 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( -IOB%salt_flux(i-i0,j-j0) ) + if (CS%check_no_land_fluxes) & + 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(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -508,7 +567,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice ! melt. This calculation is clearly WRONG if either sea-ice has variable ! salinity or the sea-ice is completely fresh. @@ -516,15 +575,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc ! is constant. ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & + net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * US%L_to_m**2*G%areaT(i,j) * & (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf @@ -586,9 +646,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points [m3 s-1] net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. - ustar_tmp ! A temporary array of ustar values [m s-1]. + ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. - real :: I_GEarth ! 1.0 / G%G_Earth [s2 m-1] + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [kg m-2] @@ -752,7 +812,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -806,10 +866,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZI_(G),SZJB_(G)), & optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid [Pa]. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: ustar !< The surface friction velocity [Z s-1 ~> m s-1]. + optional, intent(inout) :: ustar !< The surface friction velocity [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without - !! any contributions from gustiness [Z s-1 ~> m s-1]. + !! any contributions from gustiness [Z T-1 ~> m s-1]. integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables @@ -821,7 +881,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [Pa] at q points real :: gustiness ! unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 ! Inverse of the mean density rescaled to [Z2 m kg-1 ~> m3 kg-1] + real :: Irho0 ! Inverse of the mean density rescaled to [Z2 s2 m T-2 kg-1 ~> m3 kg-1] real :: taux2, tauy2 ! squared wind stresses [Pa2] real :: tau_mag ! magnitude of the wind stress [Pa] @@ -835,7 +895,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) - Irho0 = US%m_to_Z**2 / CS%Rho0 + Irho0 = (US%m_to_Z*US%T_to_s)**2 / CS%Rho0 do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) @@ -938,7 +998,6 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (associated(IOB%stress_mag)) then if (do_ustar) then ; do j=js,je ; do i=is,ie gustiness = CS%gust_const - !### SIMPLIFY THE TREATMENT OF GUSTINESS! if (CS%read_gust_2d) then if ((wind_stagger == CGRID_NE) .or. & ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & @@ -949,11 +1008,15 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, endif ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif - if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = US%m_to_Z * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) -!### Change to: -! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) - enddo ; enddo ; endif + if (CS%answers_2018) then + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + enddo ; enddo ; endif + else + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + endif elseif (wind_stagger == BGRID_NE) then do j=js,je ; do i=is,ie tau_mag = 0.0 ; gustiness = CS%gust_const @@ -967,9 +1030,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie @@ -977,28 +1042,32 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo else ! C-grid wind stresses. do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / & + (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / & + (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo endif ! endif for wind friction velocity fields endif @@ -1144,10 +1213,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) real :: utide ! The RMS tidal velocity [m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags + logical :: default_2018_answers type(time_type) :: Time_frc character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam @@ -1363,21 +1433,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) 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%ustar_tidal(i,j)=sqrt(CS%cd_tides)*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%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif call time_interp_external_init -! Optionally read a x-y gustiness field in place of a global -! constant. - + ! Optionally read a x-y gustiness field in place of a global constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1393,6 +1461,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) gust_file = trim(CS%inputdir) // trim(gust_file) call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa endif + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", CS%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) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & @@ -1400,6 +1475,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & @@ -1423,6 +1501,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) + call get_param(param_file, mdl, "CHECK_NO_LAND_FLUXES", CS%check_no_land_fluxes, & + "If true, checks that values from IOB fluxes are zero "//& + "above land points (i.e. G%mask2dT = 0).", default=.false., & + debuggingParam=.true.) + call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) if (CS%restore_salt) then @@ -1447,8 +1530,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1463,7 +1546,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1481,7 +1564,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() @@ -1528,4 +1611,32 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) end subroutine ice_ocn_bnd_type_chksum -end module MOM_surface_forcing +!> Check the values passed by IOB over land are zero +subroutine check_mask_val_consistency(val, mask, i, j, varname, G) + + real, intent(in) :: val !< value of flux/variable passed by IOB + real, intent(in) :: mask !< value of ocean mask + integer, intent(in) :: i, j !< model grid cell indices + character(len=*), intent(in) :: varname !< variable name + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + ! Local variables + character(len=48) :: ci, cj !< model local grid cell indices as strings + character(len=48) :: ciglo, cjglo !< model global grid cell indices as strings + character(len=48) :: cval !< value to be displayed + character(len=256) :: error_message !< error message to be displayed + + if ((mask == 0.) .and. (val /= 0.)) then + write(ci, '(I8)') i + write(cj, '(I8)') j + write(ciglo, '(I8)') i + G%HI%idg_offset + write(cjglo, '(I8)') j + G%HI%jdg_offset + write(cval, '(E22.16)') val + error_message = "MOM_surface_forcing: found non-zero value (="//trim(cval)//") over land "//& + "for variable "//trim(varname)//" at local point (i, j) = ("//trim(ci)//", "//trim(cj)//& + ", global point (iglo, jglo) = ("//trim(ciglo)//", "//trim(cjglo)//")" + call MOM_error(WARNING, error_message) + endif + +end subroutine + +end module MOM_surface_forcing_gfdl diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index f9b84a97e1..c5d10c7aaf 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -33,10 +33,10 @@ module ocean_model_mod 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, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart +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 +use MOM_surface_forcing_gfdl, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing_gfdl, only : forcing_save_restart use MOM_time_manager, only : time_type, operator(>), operator(+), operator(-) use MOM_time_manager, only : operator(*), operator(/), operator(/=) use MOM_time_manager, only : operator(<=), operator(>=), operator(<) @@ -393,7 +393,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -505,7 +505,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call convert_IOB_to_forces(Ice_ocean_boundary, OS%forces, index_bnds, OS%Time_dyn, OS%grid, OS%US, & OS%forcing_CSp, dt_forcing=dt_coupling, reset_avg=OS%fluxes%fluxes_used) if (OS%use_ice_shelf) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) if (OS%icebergs_alter_ocean) & call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) @@ -659,9 +659,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif ! Translate state into Ocean. -! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & +! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn call coupler_type_send_data(Ocean_sfc%fields, Time1) @@ -817,7 +817,7 @@ end subroutine initialize_ocean_public_type !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no !! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(ocean_public_type), & @@ -825,6 +825,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface [Pa]. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g) [m Pa-1]. @@ -871,12 +872,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -938,7 +939,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1036,7 +1037,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 77099b2595..ad2352d460 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -46,9 +46,6 @@ module MOM_surface_forcing !* The boundaries always run through q grid points (x). * !* * !********+*********+*********+*********+*********+*********+*********+** -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE use MOM_diag_mediator, only : post_data, query_averaging_enabled @@ -101,7 +98,7 @@ module MOM_surface_forcing real :: len_lat ! domain length in latitude real :: Rho0 ! Boussinesq reference density [kg m-3] - real :: G_Earth ! gravitational acceleration [m s-2] + real :: G_Earth ! gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const ! piston velocity for surface restoring [m s-1] real :: gust_const ! constant unresolved background gustiness for ustar [Pa] @@ -131,7 +128,6 @@ module MOM_surface_forcing character(len=8) :: wind_stagger type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() type(diag_ctrl), pointer :: diag ! structure used to regulate timing of diagnostic output @@ -356,11 +352,11 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)/CS%Rho0) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const/CS%Rho0) enddo ; enddo ; endif endif @@ -479,7 +475,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(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 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -540,12 +536,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -565,13 +561,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((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%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(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 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -697,16 +693,16 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_w", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(trim(CS%inputdir)//trim(CS%freshdischarge_file), "disch_s", & temp(:,:), G%Domain, timelevel=time_lev_monthly) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then call MOM_read_data(trim(CS%inputdir)//trim(CS%SSTrestore_file), "TEMP", & CS%T_Restore(:,:), G%Domain, timelevel=time_lev_monthly) call MOM_read_data(trim(CS%inputdir)//trim(CS%salinityrestore_file), "SALT", & @@ -756,7 +752,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 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 * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -769,16 +765,6 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) endif endif ! end RESTOREBUOY -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif - call callTree_leave("buoyancy_forcing_from_files") end subroutine buoyancy_forcing_from_files @@ -900,8 +886,8 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) "RESTOREBUOY to linear not written yet.") !do j=js,je ; do i=is,ie ! if (G%mask2dT(i,j) > 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) + ! fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - sfc_state%sfc_density(i,j)) * & + ! (CS%G_Earth * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) ! else ! fluxes%buoy(i,j) = 0.0 ! endif @@ -1123,7 +1109,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + 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, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & @@ -1149,15 +1135,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C elseif (trim(CS%wind_config) == "MESO" .or. trim(CS%buoy_config) == "MESO" ) then call MOM_error(FATAL, "MESO forcing is not available with the ice-shelf"//& "version of MOM_surface_forcing.") -! call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) endif call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) ! Set up any restart fields associated with the forcing. call restart_init(G, param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1172,8 +1155,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - call user_revise_forcing_init(param_file, CS%urf_CS) call cpu_clock_end(id_clock_forcing) @@ -1189,8 +1170,6 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/ice_solo_driver/ice_shelf_driver.F90 b/config_src/ice_solo_driver/ice_shelf_driver.F90 index 1d6f46427d..828dbf301c 100644 --- a/config_src/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/ice_solo_driver/ice_shelf_driver.F90 @@ -148,7 +148,7 @@ program SHELF_main namelist /ice_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds - !####################################################################### + !======================================================================= call write_cputime_start_clock(write_CPU_CSp) diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 2d899ce1bb..1652db2ceb 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -80,7 +80,7 @@ module user_surface_forcing logical :: restorebuoy ! If true, use restoring surface buoyancy forcing. real :: Rho0 ! The density used in the Boussinesq ! approximation [kg m-3]. - real :: G_Earth ! The gravitational acceleration [m s-2]. + real :: G_Earth ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const ! The restoring rate at the surface [m s-1]. real :: gust_const ! A constant unresolved background gustiness ! that contributes to ustar [Pa]. @@ -106,7 +106,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! This subroutine sets the surface wind stresses, forces%taux and forces%tauy [Pa]. ! In addition, this subroutine can be used to set the surface friction velocity, -! forces%ustar [Z s-1 ~> m s-1], which is needed with a bulk mixed layer. +! forces%ustar [Z T-1 ~> m s-1], which is needed with a bulk mixed layer. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -139,7 +139,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Set the surface friction velocity [Z s-1 ~> m s-1]. ustar is always positive. 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) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/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 @@ -149,7 +149,7 @@ end subroutine USER_wind_forcing !> This subroutine specifies the current surface fluxes of buoyancy or !! temperature and fresh water. It may also be modified to add !! surface fluxes of user provided tracers. -subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -157,6 +157,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] 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(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init @@ -180,7 +181,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -234,7 +235,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -268,7 +269,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, 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 * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -283,9 +284,10 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine USER_buoyancy_forcing !> This subroutine initializes the USER_surface_forcing module -subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time 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(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to @@ -311,7 +313,7 @@ subroutine USER_surface_forcing_init(Time, G, 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) + 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, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/mct_driver/mom_ocean_model_mct.F90 b/config_src/mct_driver/mom_ocean_model_mct.F90 index ec894f1ebb..94bc15cec8 100644 --- a/config_src/mct_driver/mom_ocean_model_mct.F90 +++ b/config_src/mct_driver/mom_ocean_model_mct.F90 @@ -411,7 +411,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif call close_param_file(param_file) @@ -525,7 +525,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -560,7 +560,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -684,7 +684,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") @@ -858,7 +858,7 @@ end subroutine initialize_ocean_public_type !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no !! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(ocean_public_type), & @@ -866,6 +866,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. @@ -913,12 +914,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -992,7 +993,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1090,7 +1091,7 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/mct_driver/mom_surface_forcing_mct.F90 b/config_src/mct_driver/mom_surface_forcing_mct.F90 index dd26205866..d43f9f064b 100644 --- a/config_src/mct_driver/mom_surface_forcing_mct.F90 +++ b/config_src/mct_driver/mom_surface_forcing_mct.F90 @@ -2,9 +2,6 @@ module MOM_surface_forcing_mct ! This file is part of MOM6. See LICENSE.md for the license. -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -66,14 +63,14 @@ module MOM_surface_forcing_mct logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). - real :: Rho0 !< Boussinesq reference density [kg/m^3] - real :: area_surf = -1.0 !< total ocean surface area [m^2] - real :: latent_heat_fusion !< latent heat of fusion [J/kg] - real :: latent_heat_vapor !< latent heat of vaporization [J/kg] + real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: area_surf = -1.0 !< total ocean surface area [m2] + real :: latent_heat_fusion !< latent heat of fusion [J kg-1] + real :: latent_heat_vapor !< latent heat of vaporization [J kg-1] real :: max_p_surf !< maximum surface pressure that can be !! exerted by the atmosphere and floating sea-ice, - !! in Pa. This is needed because the FMS coupling + !! [Pa]. This is needed because the FMS coupling !! structure does not limit the water that can be !! frozen out of the ocean and the ice-ocean heat !! fluxes are treated explicitly. @@ -98,8 +95,9 @@ module MOM_surface_forcing_mct logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] - real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -139,12 +137,9 @@ module MOM_surface_forcing_mct integer :: id_srestore = -1 !< id number for time_interp_external. integer :: id_trestore = -1 !< id number for time_interp_external. - ! Diagnostics handles - type(forcing_diags), public :: handles - - !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - type(user_revise_forcing_CS), pointer :: urf_CS => NULL() + type(forcing_diags), public :: handles !< diagnostics handles + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< user revise pointer end type surface_forcing_CS !> Structure corresponding to forcing, but with the elements, units, and conventions @@ -306,7 +301,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & 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) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -336,7 +331,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -368,7 +363,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -389,7 +384,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -540,15 +535,16 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) - net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf @@ -596,18 +592,18 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) tauy_at_q !< Meridional wind stresses at q points [Pa] real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & !< Ice rigidity at tracer points (m3 s-1) + rigidity_at_h, & !< Ice rigidity at tracer points [m3 s-1] taux_at_h, & !< Zonal wind stresses at h points [Pa] tauy_at_h !< Meridional wind stresses at h points [Pa] real :: gustiness !< unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 !< inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 !< squared wind stresses (Pa^2) + real :: Irho0 !< inverse of the mean density in [m3 kg-1] + real :: taux2, tauy2 !< squared wind stresses [Pa2] real :: tau_mag !< magnitude of the wind stress [Pa] - real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) - real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) - real :: mass_ice !< mass of sea ice at a face (kg/m^2) - real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) + real :: I_GEarth !< 1.0 / G%G_Earth [s2 m-1] + real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] + real :: mass_ice !< mass of sea ice at a face [kg m-2] + real :: mass_eff !< effective mass of sea ice for rigidity [kg m-2] integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 @@ -757,7 +753,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo; enddo elseif (wind_stagger == AGRID) then @@ -782,7 +778,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo; enddo @@ -803,9 +799,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo; enddo @@ -826,7 +822,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1208,13 +1204,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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%ustar_tidal(i,j)=sqrt(CS%cd_tides)*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%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif @@ -1245,6 +1241,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & @@ -1293,8 +1292,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1309,8 +1306,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - call user_revise_forcing_init(param_file, CS%urf_CS) call cpu_clock_end(id_clock_forcing) @@ -1327,8 +1322,6 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index b42fa8ca7e..0b7a331458 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -212,7 +212,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! d/dx ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%IdxT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdx, n) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = (ssh(I,j) - ssh(I-1,j)) * grid%mask2dCu(I-1,j) if (grid%mask2dCu(I-1,j)==0.) slp_L = 0. @@ -230,14 +230,14 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshx(i,j) = slope * grid%IdxT(i,j) * grid%mask2dT(i,j) + sshx(i,j) = slope * grid%US%m_to_L*grid%IdxT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshx(i,j) = 0.0 enddo; enddo ! d/dy ssh do j=grid%jsc, grid%jec ; do i=grid%isc,grid%iec ! This is a simple second-order difference - ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%IdyT(i,j) * grid%mask2dT(i,j) + ! o2x(ind%o2x_So_dhdy, n) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) ! This is a PLM slope which might be less prone to the A-grid null mode slp_L = ssh(i,J) - ssh(i,J-1) * grid%mask2dCv(i,J-1) if (grid%mask2dCv(i,J-1)==0.) slp_L = 0. @@ -257,7 +257,7 @@ subroutine ocn_export(ind, ocn_public, grid, o2x, dt_int, ncouple_per_day) ! larger extreme values. slope = 0.0 endif - sshy(i,j) = slope * grid%IdyT(i,j) * grid%mask2dT(i,j) + sshy(i,j) = slope * grid%US%m_to_L*grid%IdyT(i,j) * grid%mask2dT(i,j) if (grid%mask2dT(i,j)==0.) sshy(i,j) = 0.0 enddo; enddo diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index a7495d7a7f..a6aebade08 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -642,7 +642,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) integer, pointer :: idata(:) integer :: i,j,k real(kind=SHR_REAL_R8), pointer :: data(:) - real(kind=SHR_REAL_R8) :: m2_to_rad2 + real(kind=SHR_REAL_R8) :: L2_to_rad2 type(ocean_grid_type), pointer :: grid => NULL() ! A pointer to a grid structure grid => glb%grid ! for convenience @@ -687,11 +687,11 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - m2_to_rad2 = 1./grid%Rad_Earth**2 + L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex - data(k) = grid%AreaT(i,j) * m2_to_rad2 + data(k) = grid%AreaT(i,j) * L2_to_rad2 enddo enddo call mct_gGrid_importRattr(dom_ocn,"area",data,lsize) @@ -749,7 +749,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 0caee9510e..4754853a5d 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -1669,7 +1669,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) dataPtr_xcen(i1,j1) = ocean_grid%geolonT(ig,jg) dataPtr_ycen(i1,j1) = ocean_grid%geolatT(ig,jg) if(grid_attach_area) then - dataPtr_area(i1,j1) = ocean_grid%areaT(ig,jg) + dataPtr_area(i1,j1) = ocean_grid%US%L_to_m**2 * ocean_grid%areaT(ig,jg) endif enddo enddo diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 8cb1a2ca4c..2f872c7da5 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -548,7 +548,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! d/dx ssh ! This is a simple second-order difference - ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdx(i,j) = 0.5 * (ssh(i+1,j) - ssh(i-1,j)) * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -571,14 +571,14 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdx(iglob,jglob) = slope * ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) + dhdx(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdxT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdx(iglob,jglob) = 0.0 enddo enddo ! d/dy ssh ! This is a simple second-order difference - ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) + ! dhdy(i,j) = 0.5 * (ssh(i,j+1) - ssh(i,j-1)) * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(ig,jg) do jglob = jsc, jec j = jglob + ocean_grid%jsc - jsc @@ -601,7 +601,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! larger extreme values. slope = 0.0 endif - dhdy(iglob,jglob) = slope * ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) + dhdy(iglob,jglob) = slope * ocean_grid%US%m_to_L*ocean_grid%IdyT(i,j) * ocean_grid%mask2dT(i,j) if (ocean_grid%mask2dT(i,j)==0.) dhdy(iglob,jglob) = 0.0 enddo enddo diff --git a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 index 426c7e9922..d9f66820bd 100644 --- a/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 +++ b/config_src/nuopc_driver/mom_ocean_model_nuopc.F90 @@ -416,7 +416,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) endif @@ -527,7 +527,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -558,7 +558,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (do_thermo) & call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) if (do_dyn) & - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + call add_shelf_forces(OS%grid, OS%US, OS%Ice_shelf_CSp, OS%forces) endif if (OS%icebergs_alter_ocean) then if (do_dyn) & @@ -679,7 +679,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! Translate state into Ocean. ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") @@ -853,7 +853,7 @@ end subroutine initialize_ocean_public_type !! code that calculates the surface state in the first place. !! Note the offset in the arrays because the ocean_data_type has no !! halo points in its arrays and always uses absolute indicies. -subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_to_z) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(ocean_public_type), & @@ -861,6 +861,7 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z !! visible ocean surface fields, whose elements !! have their data set here. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. @@ -907,12 +908,12 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z if (present(patm)) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + Ocean_sfc%area(i,j) = US%L_to_m**2*G%areaT(i+i0,j+j0) enddo ; enddo endif @@ -986,7 +987,7 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call extract_surface_state(OS%MOM_CSp, OS%sfc_state) - call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) end subroutine ocean_model_init_sfc @@ -1084,7 +1085,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) select case(name) case('area') - array2D(isc:,jsc:) = OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) + array2D(isc:,jsc:) = OS%US%L_to_m**2*OS%grid%areaT(g_isc:g_iec,g_jsc:g_jec) case('mask') array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec) !OR same result diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index b6517de9e4..cdd93a8772 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -3,9 +3,6 @@ module MOM_surface_forcing_nuopc ! This file is part of MOM6. See LICENSE.md for the license. -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -92,7 +89,7 @@ module MOM_surface_forcing_nuopc gust => NULL(), & !< spatially varying unresolved background !! gustiness that contributes to ustar [Pa]. !! gust is used when read_gust_2d is true. - ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) real :: utide !< constant tidal velocity to use if read_tideamp !! is false [m s-1] @@ -101,8 +98,9 @@ module MOM_surface_forcing_nuopc logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] - real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -147,7 +145,6 @@ module MOM_surface_forcing_nuopc ! Diagnostics handles type(forcing_diags), public :: handles -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS @@ -309,7 +306,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & 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) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo ; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -340,7 +337,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie - work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) + work_sum(i,j) = US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) enddo ; enddo CS%area_surf = reproducing_sum(work_sum, isr, ier, jsr, jer) endif ! endif for allocation and initialization @@ -372,7 +369,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl) fluxes%saltFluxGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%salt_flux(is:ie,js:je) fluxes%saltFluxGlobalAdj = reproducing_sum(work_sum(:,:), isr,ier, jsr,jer)/CS%area_surf fluxes%salt_flux(is:ie,js:je) = fluxes%salt_flux(is:ie,js:je) - fluxes%saltFluxGlobalAdj endif @@ -393,7 +390,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl) fluxes%vPrecGlobalAdj = 0. else - work_sum(is:ie,js:je) = G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) + work_sum(is:ie,js:je) = US%L_to_m**2*G%areaT(is:ie,js:je)*fluxes%vprec(is:ie,js:je) fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf do j=js,je ; do i=is,ie fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j) @@ -429,32 +426,32 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! liquid runoff flux if (associated(IOB%rofl_flux)) then - fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) else if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - end if + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + endif ! ice runoff flux if (associated(IOB%rofi_flux)) then - fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) - else if (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - end if + fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + elseif (associated(IOB%calving)) then + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + endif if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%mass_berg)) & - fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -525,16 +522,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & enddo ; enddo endif - !### if (associated(CS%ctrl_forcing_CSp)) then - !### do j=js,je ; do i=is,ie - !### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) - !### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) - !### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) - !### enddo ; enddo - !### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & - !### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) - !### endif - ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then sign_for_net_FW_bug = 1. @@ -542,15 +529,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & - (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - - net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) + (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) + net_FW2(i,j) = net_FW(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo if (CS%adjust_net_fresh_water_by_scaling) then call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl) do j=js,je ; do i=is,ie - fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j) + fluxes%vprec(i,j) = fluxes%vprec(i,j) + & + (net_FW2(i,j) - net_FW(i,j)/(US%L_to_m**2*G%areaT(i,j))) * G%mask2dT(i,j) enddo ; enddo else fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf @@ -607,7 +594,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 !< inverse of the mean density in (m^3/kg) real :: taux2, tauy2 !< squared wind stresses (Pa^2) real :: tau_mag !< magnitude of the wind stress [Pa] - real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth !< 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice !< mass of sea ice at a face (kg/m^2) real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) @@ -763,7 +750,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then @@ -788,7 +775,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -809,9 +796,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -832,7 +819,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%g_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1213,13 +1200,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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%ustar_tidal(i,j)=sqrt(CS%cd_tides)*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%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif @@ -1250,6 +1237,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & @@ -1298,8 +1288,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1314,8 +1302,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) - call user_revise_forcing_init(param_file, CS%urf_CS) call cpu_clock_end(id_clock_forcing) @@ -1332,8 +1318,6 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) - if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 1ce96fdac2..ee3cd36b41 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -15,6 +15,7 @@ module MESO_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -27,7 +28,7 @@ module MESO_surface_forcing 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 [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -54,7 +55,7 @@ module MESO_surface_forcing !> This subroutine sets up the MESO buoyancy forcing, which uses control-theory style !! specification restorative buoyancy fluxes at large scales. -subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -62,6 +63,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] 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(MESO_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by !! a previous call to MESO_surface_forcing_init @@ -81,7 +83,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -113,7 +115,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. - if (CS%restorebuoy .and. first_call) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy .and. first_call) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then call safe_alloc_ptr(CS%T_Restore, isd, ied, jsd, jed) call safe_alloc_ptr(CS%S_Restore, isd, ied, jsd, jed) call safe_alloc_ptr(CS%Heat, isd, ied, jsd, jed) @@ -153,7 +155,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -189,7 +191,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, 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 * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -204,10 +206,11 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine MESO_buoyancy_forcing !> Initialize the MESO surface forcing module -subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine MESO_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time 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(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output type(MESO_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the @@ -233,7 +236,7 @@ subroutine MESO_surface_forcing_init(Time, G, 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) + 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, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 22a216cb80..b057e06f9e 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -210,7 +210,7 @@ program MOM_main namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds,& ocean_nthreads, ncores_per_node, use_hyper_thread - !####################################################################### + !===================================================================== call write_cputime_start_clock(write_CPU_CSp) @@ -488,7 +488,7 @@ program MOM_main if (use_ice_shelf) then call shelf_calc_flux(sfc_state, fluxes, Time, dt_forcing, ice_shelf_CSp) - call add_shelf_forces(grid, Ice_shelf_CSp, forces) + call add_shelf_forces(grid, US, Ice_shelf_CSp, forces) endif fluxes%fluxes_used = .false. fluxes%dt_buoy_accum = dt_forcing diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 6fe06daea8..442047f03c 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -79,7 +79,7 @@ module MOM_surface_forcing real :: len_lat !< domain length in latitude real :: Rho0 !< Boussinesq reference density [kg m-3] - real :: G_Earth !< gravitational acceleration [m s-2] + real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< piston velocity for surface restoring [m s-1] real :: Flux_const_T !< piston velocity for surface temperature restoring [m s-1] real :: Flux_const_S !< piston velocity for surface salinity restoring [m s-1] @@ -105,7 +105,10 @@ module MOM_surface_forcing real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' - + 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. real :: T_north !< target temperatures at north used in buoyancy_forcing_linear real :: T_south !< target temperatures at south used in buoyancy_forcing_linear @@ -124,7 +127,7 @@ module MOM_surface_forcing !! are staggered in WIND_FILE. Valid values are A or C for now. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< A pointer to the structure !! that is used to orchestrate the calling of tracer packages -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output @@ -298,9 +301,9 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. & (.not.CS%adiabatic)) then if (trim(CS%buoy_config) == "file") then - call buoyancy_forcing_from_files(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_from_files(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "data_override") then - call buoyancy_forcing_from_data_override(sfc_state, fluxes, day_center, dt, G, CS) + call buoyancy_forcing_from_data_override(sfc_state, fluxes, day_center, dt, G, US, CS) elseif (trim(CS%buoy_config) == "zero") then call buoyancy_forcing_zero(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "const") then @@ -308,15 +311,15 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US elseif (trim(CS%buoy_config) == "linear") then call buoyancy_forcing_linear(sfc_state, fluxes, day_center, dt, G, CS) elseif (trim(CS%buoy_config) == "MESO") then - call MESO_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%MESO_forcing_CSp) + call MESO_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%MESO_forcing_CSp) elseif (trim(CS%buoy_config) == "Neverland") then - call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%Neverland_forcing_CSp) + call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%Neverland_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then - call USER_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%user_forcing_CSp) + call USER_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%user_forcing_CSp) elseif (trim(CS%buoy_config) == "BFB") then - call BFB_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%BFB_forcing_CSp) + call BFB_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, US, CS%BFB_forcing_CSp) elseif (trim(CS%buoy_config) == "dumbbell") then call dumbbell_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%dumbbell_forcing_CSp) elseif (trim(CS%buoy_config) == "NONE") then @@ -388,11 +391,11 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) enddo ; enddo ; endif endif @@ -477,7 +480,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables - real :: PI, y + real :: PI, y, I_rho integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") @@ -488,7 +491,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) do j=js-1,je+1 ; do I=is-1,Ieq - y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat + y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) @@ -498,12 +501,21 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = 0.0 enddo ; enddo - ! set the friction velocity !### Add parenthesis so that this is rotationally invariant. - do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(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 + (CS%gust_const/CS%Rho0)) - enddo ; enddo + ! set the friction velocity + if (CS%answers_2018) then + do j=js,je ; do i=is,ie + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(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 + (CS%gust_const/CS%Rho0)) + enddo ; enddo + else + I_rho = 1.0 / CS%Rho0 + do j=js,je ; do i=is,ie + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( (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))) ) * I_rho ) + enddo ; enddo + endif call callTree_leave("wind_forcing_gyres") end subroutine wind_forcing_gyres @@ -584,12 +596,12 @@ 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 - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -629,13 +641,13 @@ 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 - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((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%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(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 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -648,7 +660,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (read_Ustar) then call MOM_read_data(filename, CS%Ustar_var, forces%ustar(:,:), & - G%Domain, timelevel=time_lev, scale=US%Z_to_m) + G%Domain, timelevel=time_lev, scale=US%m_to_Z*US%T_to_s) endif CS%wind_last_lev = time_lev @@ -703,19 +715,19 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) read_Ustar = (len_trim(CS%ustar_var) > 0) ! Need better control higher up ???? if (read_Ustar) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*forces%ustar(i,j) ; enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*US%s_to_T*forces%ustar(i,j) ; enddo ; enddo call data_override('OCN', 'ustar', temp_ustar, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*temp_ustar(i,j) ; enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*US%T_to_s*temp_ustar(i,j) ; enddo ; enddo else if (CS%read_gust_2d) then call data_override('OCN', 'gust', CS%gust, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -729,7 +741,7 @@ end subroutine wind_forcing_by_data_override !> Specifies zero surface bouyancy fluxes from input files. -subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -737,6 +749,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] 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(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -896,12 +909,12 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) call MOM_read_data(CS%runoff_file, CS%lrunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%lrunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%lrunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo call MOM_read_data(CS%runoff_file, CS%frunoff_var, temp(:,:), & G%Domain, timelevel=time_lev) do j=js,je ; do i=is,ie - fluxes%frunoff(i,j) = temp(i,j)*G%IareaT(i,j) + fluxes%frunoff(i,j) = temp(i,j)*US%m_to_L**2*G%IareaT(i,j) enddo ; enddo else call MOM_read_data(CS%runoff_file, CS%lrunoff_var, fluxes%lrunoff(:,:), & @@ -912,7 +925,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) CS%runoff_last_lev = time_lev ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then select case (CS%SST_nlev) case (12) ; time_lev = time_lev_monthly case (365) ; time_lev = time_lev_daily @@ -978,7 +991,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 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 * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -993,21 +1006,21 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) endif ! end RESTOREBUOY -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif call callTree_leave("buoyancy_forcing_from_files") end subroutine buoyancy_forcing_from_files !> Specifies zero surface bouyancy fluxes from data over-ride. -subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS) +subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -1015,6 +1028,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] 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(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables @@ -1094,7 +1108,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then call data_override('OCN', 'SST_restore', CS%T_restore(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) @@ -1122,7 +1136,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS do j=js,je ; do i=is,ie if (G%mask2dT(i,j) > 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 * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) else fluxes%buoy(i,j) = 0.0 endif @@ -1159,15 +1173,15 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS enddo ; enddo -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") end subroutine buoyancy_forcing_from_data_override @@ -1321,7 +1335,7 @@ subroutine buoyancy_forcing_linear(sfc_state, fluxes, day, dt, G, CS) !do j=js,je ; do i=is,ie ! if (G%mask2dT(i,j) > 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 * US%m_to_Z*US%T_to_s*CS%Flux_const/CS%Rho0) ! else ! fluxes%buoy(i,j) = 0.0 ! endif @@ -1367,12 +1381,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< Forcing for tracers? + ! Local variables type(directories) :: dirs logical :: new_sim type(time_type) :: Time_frc -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" + logical :: default_2018_answers character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=200) :: filename, gust_file ! The name of the gustiness input file. @@ -1601,6 +1617,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "the zonal wind stress profile: "//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="nondim", default=0.0) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "WIND_GYRES_2018_ANSWERS", CS%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) + else + CS%answers_2018 = .false. endif if ((trim(CS%wind_config) == "2gyre") .or. & (trim(CS%wind_config) == "1gyre") .or. & @@ -1669,7 +1695,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80) + 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, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & @@ -1690,15 +1716,15 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! All parameter settings are now known. if (trim(CS%wind_config) == "USER" .or. trim(CS%buoy_config) == "USER" ) then - call USER_surface_forcing_init(Time, G, param_file, diag, CS%user_forcing_CSp) + call USER_surface_forcing_init(Time, G, US, param_file, diag, CS%user_forcing_CSp) elseif (trim(CS%buoy_config) == "BFB" ) then - call BFB_surface_forcing_init(Time, G, param_file, diag, CS%BFB_forcing_CSp) + call BFB_surface_forcing_init(Time, G, US, param_file, diag, CS%BFB_forcing_CSp) elseif (trim(CS%buoy_config) == "dumbbell" ) then - call dumbbell_surface_forcing_init(Time, G, param_file, diag, CS%dumbbell_forcing_CSp) + call dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS%dumbbell_forcing_CSp) elseif (trim(CS%wind_config) == "MESO" .or. trim(CS%buoy_config) == "MESO" ) then - call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) + call MESO_surface_forcing_init(Time, G, US, param_file, diag, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then - call Neverland_surface_forcing_init(Time, G, param_file, diag, CS%Neverland_forcing_CSp) + call Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "ideal_hurr" .or.& trim(CS%wind_config) == "SCM_ideal_hurr") then call idealized_hurricane_wind_init(Time, G, param_file, CS%idealized_hurricane_CSp) @@ -1719,8 +1745,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1753,7 +1779,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C if (trim(CS%wind_config) == "file") & CS%wind_nlev = num_timelevels(CS%wind_file, CS%stress_x_var, min_dims=3) -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1773,7 +1799,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 71e91a539c..be29466e14 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -33,7 +33,7 @@ module Neverland_surface_forcing logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq !! approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: flux_const !< The restoring rate at the surface [m s-1]. real, dimension(:,:), pointer :: & buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. @@ -104,7 +104,7 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. ! 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) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & +! forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/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 @@ -135,17 +135,18 @@ end function spike !> Surface fluxes of buoyancy for the Neverland configurations. -subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< Forcing fields. type(time_type), intent(in) :: day !< Time used for determining the fluxes. real, intent(in) :: dt !< Forcing time step (s). - type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(Neverland_surface_forcing_CS), pointer :: CS !< Control structure for this module. ! Local variables real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. real :: density_restore ! De integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -179,7 +180,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) "Temperature/salinity restoring not coded!" ) else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -194,7 +195,7 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! so that the original (unmodified) version is not accidentally used. ! 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 * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -209,9 +210,10 @@ subroutine Neverland_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine Neverland_buoyancy_forcing !> Initializes the Neverland control structure. -subroutine Neverland_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine Neverland_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. 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 indicating the open file to parse for !! model parameter values. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. @@ -238,7 +240,7 @@ subroutine Neverland_surface_forcing_init(Time, G, 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) + 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, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 5ff39ae8c4..92151e6cde 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -34,7 +34,7 @@ module user_surface_forcing 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 [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 s-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -88,7 +88,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. 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) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/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 @@ -98,7 +98,7 @@ end subroutine USER_wind_forcing !> This subroutine specifies the current surface fluxes of buoyancy or !! temperature and fresh water. It may also be modified to add !! surface fluxes of user provided tracers. -subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) +subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields @@ -106,6 +106,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] 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(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned !! by a previous call to user_surface_forcing_init @@ -130,7 +131,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -184,7 +185,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -218,7 +219,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, 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 * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential ! density [kg m-3] that is being restored toward. @@ -233,9 +234,10 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) end subroutine USER_buoyancy_forcing !> This subroutine initializes the USER_surface_forcing module -subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine USER_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time 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(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to @@ -261,7 +263,7 @@ subroutine USER_surface_forcing_init(Time, G, 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) + 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, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/config_src/unit_drivers/MOM_sum_driver.F90 b/config_src/unit_drivers/MOM_sum_driver.F90 index 4778bc2167..5673b201ee 100644 --- a/config_src/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/unit_drivers/MOM_sum_driver.F90 @@ -60,7 +60,7 @@ program MOM_main character(len=40) :: mdl = "MOM_main (MOM_sum_driver)" ! This module's name. character(len=200) :: mesg - !####################################################################### + !======================================================================= call MOM_infra_init() ; call io_infra_init() diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index b9aedb7a1c..33b498a60a 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -307,8 +307,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -639,16 +639,16 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Vertical grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h !< Original thicknesses + intent(inout) :: h !< Original thicknesses [H ~> m or kg-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermo vars (T/S/EOS) integer, intent(in) :: n !< Number of times to regrid real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] type(tracer_registry_type), & optional, pointer :: Reg !< Tracer registry to remap onto new grid - real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding + real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding [s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions logical, optional, intent(in) :: initial !< Whether we're being called from an initialization @@ -732,11 +732,11 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, optional, intent(in) :: dxInterface !< Change in interface position !! [H ~> m or kg-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(inout) :: u !< Zonal velocity component [m s-1] + optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(inout) :: v !< Meridional velocity component [m s-1] - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + optional, 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 ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -900,7 +900,7 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid !! [H ~> m or kg-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid logical, optional, intent(in) :: all_cells !< If false, only reconstruct for diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 301969ed50..23c11cc05b 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -55,7 +55,6 @@ module MOM use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end -use MOM_diabatic_driver, only : legacy_diabatic use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics use MOM_diagnostics, only : register_surface_diags, write_static_fields @@ -87,6 +86,7 @@ module MOM use MOM_open_boundary, only : ocean_OBC_type, OBC_registry_type use MOM_open_boundary, only : register_temp_salt_segments use MOM_open_boundary, only : open_boundary_register_restarts +use MOM_open_boundary, only : update_segment_tracer_reservoirs use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS use MOM_sponge, only : init_sponge_diags, sponge_CS @@ -156,13 +156,13 @@ module MOM T, & !< potential temperature [degC] S !< salinity [ppt] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u, & !< zonal velocity component [m s-1] - uh, & !< uh = u * h * dy at u grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - uhtr !< accumulated zonal thickness fluxes to advect tracers [H m2 ~> m3 or kg] + u, & !< zonal velocity component [L T-1 ~> m s-1] + uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1] + uhtr !< accumulated zonal thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v, & !< meridional velocity [m s-1] - vh, & !< vh = v * h * dx at v grid points [H m2 s-1 ~> m3 s-1 or kg s-1] - vhtr !< accumulated meridional thickness fluxes to advect tracers [H m2 ~> m3 or kg] + v, & !< meridional velocity [L T-1 ~> m s-1] + vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] + vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint !< A running time integral of the sea surface height [s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc @@ -204,8 +204,6 @@ module MOM !! related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. - logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the diabatic - !! subroutine. This is temporary and is needed to avoid change in answers. logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time !! stepping the dynamics. logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered @@ -254,8 +252,8 @@ module MOM type(cont_diag_ptrs) :: CDp !< structure containing pointers to continuity equation !! terms, for derived diagnostics (e.g., energy budgets) real, dimension(:,:,:), pointer :: & - u_prev => NULL(), & !< previous value of u stored for diagnostics [m s-1] - v_prev => NULL() !< previous value of v stored for diagnostics [m s-1] + u_prev => NULL(), & !< previous value of u stored for diagnostics [L T-1 ~> m s-1] + v_prev => NULL() !< previous value of v stored for diagnostics [L T-1 ~> m s-1] logical :: interp_p_surf !< If true, linearly interpolate surface pressure !! over the coupling time step, using specified value @@ -464,8 +462,8 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & ssh ! sea surface height, which may be based on eta_av [m] real, dimension(:,:,:), pointer :: & - u => NULL(), & ! u : zonal velocity component [m s-1] - v => NULL(), & ! v : meridional velocity component [m s-1] + u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] + v => NULL(), & ! v : meridional velocity component [L T-1 ~> m s-1] h => NULL() ! h : layer thickness [H ~> m or kg m-2] real, dimension(:,:), pointer :: & p_surf => NULL() ! A pointer to the ocean surface pressure [Pa]. @@ -495,7 +493,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & call cpu_clock_begin(id_clock_other) if (CS%debug) then - call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Beginning of step_MOM ", u, v, h, CS%uh, CS%vh, G, GV, US) endif showCallTree = callTree_showQuery() @@ -601,7 +599,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & if (CS%debug) then if (cycle_start) & - call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) if (cycle_start) call check_redundant("Before steps ", u, v, G) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) @@ -719,7 +717,7 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & endif if (do_advection) then ! Do advective transport and lateral tracer mixing. - call step_MOM_tracer_dyn(CS, G, GV, h, Time_local) + call step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) CS%ndyn_per_adv = 0 if (CS%diabatic_first .and. abs(CS%t_dyn_rel_thermo) > 1e-6*dt) call MOM_error(FATAL, & "step_MOM: Mismatch between the dynamics and diabatic times "//& @@ -824,12 +822,12 @@ subroutine step_MOM(forces, fluxes, sfc_state, Time_start, time_interval, CS, & enddo ; enddo ; endif if (CS%ensemble_ocean) then - ! update the time for the next analysis step if needed - call set_analysis_time(CS%Time,CS%odaCS) - ! store ensemble vector in odaCS - call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) - ! call DA interface - call oda(CS%Time,CS%odaCS) + ! update the time for the next analysis step if needed + call set_analysis_time(CS%Time,CS%odaCS) + ! store ensemble vector in odaCS + call set_prior_tracer(CS%Time, G, GV, CS%h, CS%tv, CS%odaCS) + ! call DA interface + call oda(CS%Time,CS%odaCS) endif if (showCallTree) call callTree_waypoint("calling extract_surface_state (step_MOM)") @@ -943,13 +941,14 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & Time_local + real_to_time(bbl_time_int-dt), CS%diag) ! Calculate the BBL properties and store them inside visc (u,h). call cpu_clock_begin(id_clock_BBL_visc) - call set_viscous_BBL(CS%u, CS%v, CS%h, CS%tv, CS%visc, G, GV, US, & + call set_viscous_BBL(CS%u(:,:,:), CS%v(:,:,:), CS%h, CS%tv, CS%visc, G, GV, US, & CS%set_visc_CSp, symmetrize=.true.) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") call disable_averaging(CS%diag) endif + if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -1011,7 +1010,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Pre-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-mixedlayer_restrat uhtr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & @@ -1021,7 +1020,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (CS%debug) then call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-mixedlayer_restrat [uv]htr", & - CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m) + CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) endif endif @@ -1055,10 +1054,11 @@ end subroutine step_MOM_dynamics !> step_MOM_tracer_dyn does tracer advection and lateral diffusion, bringing the !! tracers up to date with the changes in state due to the dynamics. Surface !! sources and sinks and remapping are handled via step_MOM_thermo. -subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) +subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) type(MOM_control_struct), intent(inout) :: CS !< control structure type(ocean_grid_type), intent(inout) :: 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_(G)), & intent(in) :: h !< layer thicknesses after the transports [H ~> m or kg m-2] type(time_type), intent(in) :: Time_local !< The model time at the end @@ -1071,7 +1071,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_other) call hchksum(h,"Pre-advection h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-advection uhtr", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, & @@ -1085,15 +1085,17 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) call enable_averaging(CS%t_dyn_rel_adv, Time_local, CS%diag) - call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, & + call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") + call update_segment_tracer_reservoirs(G, GV, CS%uhtr, CS%vhtr, h, CS%OBC, & + CS%t_dyn_rel_adv, CS%tracer_Reg) call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_diagnostics) - call post_transport_diagnostics(G, GV, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & + call post_transport_diagnostics(G, GV, US, CS%uhtr, CS%vhtr, h, CS%transport_IDs, & CS%diag_pre_dyn, CS%diag, CS%t_dyn_rel_adv, CS%tracer_reg) ! Rebuild the remap grids now that we've posted the fields which rely on thicknesses ! from before the dynamics calls @@ -1129,9 +1131,9 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< meridional velocity [m s-1] + intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables @@ -1180,24 +1182,18 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call uvchksum("Pre-diabatic [uv]", u, v, G%HI, haloshift=2) call hchksum(h,"Pre-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Pre-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Pre-diabatic ",u, v, h, CS%uhtr, CS%vhtr, G, GV) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G,haloshift=0) call check_redundant("Pre-diabatic ", u, v, G) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) endif call cpu_clock_begin(id_clock_diabatic) - if (CS%use_legacy_diabatic_driver) then - ! the following subroutine is legacy and will be deleted in the near future. - call legacy_diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) - else - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) - endif + + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & + dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) fluxes%fluxes_used = .true. - call cpu_clock_end(id_clock_diabatic) if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -1217,7 +1213,7 @@ 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%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1) call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1) call check_redundant("Pre-ALE ", u, v, G) @@ -1244,7 +1240,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call do_group_pass(pass_uv_T_S_h, G%Domain, clock=id_clock_pass) if (CS%debug .and. CS%use_ALE_algorithm) then - call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV) + call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1) call check_redundant("Post-ALE ", u, v, G) @@ -1259,10 +1255,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call postALE_tracer_diagnostics(CS%tracer_Reg, G, GV, CS%diag, dtdia) if (CS%debug) then - call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2) + call uvchksum("Post-diabatic u", u, v, G%HI, haloshift=2, scale=US%L_T_to_m_s) call hchksum(h, "Post-diabatic h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Post-diabatic [uv]h", CS%uhtr, CS%vhtr, G%HI, & - haloshift=0, scale=GV%H_to_m) + haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Post-diabatic ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) @@ -1275,6 +1271,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call check_redundant("Post-diabatic ", u, v, G) endif call disable_averaging(CS%diag) + + call cpu_clock_end(id_clock_diabatic) else ! complement of "if (.not.CS%adiabatic)" call cpu_clock_begin(id_clock_diabatic) @@ -1407,7 +1405,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1432,7 +1430,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_resoln_function(CS%h, CS%tv, G, GV, US, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, US, CS%VarMix) endif - call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1467,7 +1465,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif @@ -1674,10 +1672,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "true. This assumes that KD = KDML = 0.0 and that "//& "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) - call get_param(param_file, "MOM", "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic_driver, & - "If true, use a legacy version of the diabatic subroutine. "//& - "This is temporary and is needed to avoid change in answers.", & - default=.true.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & "If False, skips the dynamics calls that update u & v, as well as "//& "the gravity wave adjustment to h. This is a fragile feature and "//& @@ -1962,7 +1956,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV, US ) GV => CS%GV -! dG%g_Earth = (GV%g_Earth*US%m_to_Z) +! dG%g_Earth = GV%mks_g_Earth ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -2022,7 +2016,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, dG%HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & - flux_units='W m-2', flux_longname='Heat', & + flux_units='W', flux_longname='Heat', & flux_scale=conv2watt, convergence_units='W m-2', & convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, dG%HI, GV, & @@ -2061,6 +2055,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (debug_truncations) then allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz)) ; CS%u_prev(:,:,:) = 0.0 allocate(CS%v_prev(isd:ied,JsdB:JedB,nz)) ; CS%v_prev(:,:,:) = 0.0 + MOM_internal_state%u_prev => CS%u_prev + MOM_internal_state%v_prev => CS%v_prev call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(CS%ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) if (.not.CS%adiabatic) then @@ -2146,8 +2142,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! (potentially static) ocean-specific grid type. ! The next line would be needed if G%Domain had not already been init'd above: ! call clone_MOM_domain(dG%Domain, G%Domain) - call MOM_grid_init(G, param_file, HI, bathymetry_at_vel=bathy_at_vel) - call copy_dyngrid_to_MOM_grid(dG, G) + call MOM_grid_init(G, param_file, US, HI, bathymetry_at_vel=bathy_at_vel) + call copy_dyngrid_to_MOM_grid(dG, G, US) call destroy_dyn_horgrid(dG) ! Set a few remaining fields that are specific to the ocean grid type. @@ -2158,7 +2154,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) + G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2175,10 +2171,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call clone_MOM_domain(G%Domain, dG%Domain) call clone_MOM_domain(G%Domain, CS%G%Domain) - call MOM_grid_init(CS%G, param_file) + call MOM_grid_init(CS%G, param_file, US) - call copy_MOM_grid_to_dyngrid(G, dg) - call copy_dyngrid_to_MOM_grid(dg, CS%G) + call copy_MOM_grid_to_dyngrid(G, dg, US) + call copy_dyngrid_to_MOM_grid(dg, CS%G, US) call destroy_dyn_horgrid(dG) call MOM_grid_end(G) ; deallocate(G) @@ -2187,10 +2183,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) else ; CS%G%Domain_aux => CS%G%Domain ;endif - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) + G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth endif - ! At this point, all user-modified initialization code has been called. The ! remainder of this subroutine is controlled by the parameters that have ! have already been set. @@ -2220,7 +2215,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! pass to the pointer shelf_area => frac_shelf_h @@ -2294,11 +2289,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("ALE initialized (initialize_MOM)") - CS%useMEKE = MEKE_init(Time, G, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) + CS%useMEKE = MEKE_init(Time, G, US, param_file, diag, CS%MEKE_CSp, CS%MEKE, restart_CSp) call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) + if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -2322,14 +2318,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & elseif (CS%use_RK2) then call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_RK2_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & - CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) + CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & + CS%ntrunc) else call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV, US, & param_file, diag, CS%dyn_unsplit_CSp, restart_CSp, & - CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, & - CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc) + CS%ADp, CS%CDp, MOM_internal_state, CS%MEKE, CS%OBC, & + CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, & + CS%ntrunc) endif + call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & @@ -2362,7 +2361,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call tracer_advect_init(Time, G, param_file, diag, CS%tracer_adv_CSp) - call tracer_hor_diff_init(Time, G, param_file, diag, CS%tv%eqn_of_state, & + call tracer_hor_diff_init(Time, G, US, param_file, diag, CS%tv%eqn_of_state, & CS%tracer_diff_CSp) call lock_tracer_registry(CS%tracer_Reg) @@ -2370,8 +2369,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! now register some diagnostics since the tracer registry is now locked call register_surface_diags(Time, G, CS%sfc_IDs, CS%diag, CS%tv) - call register_diags(Time, G, GV, CS%IDs, CS%diag) - call register_transport_diags(Time, G, GV, CS%transport_IDs, CS%diag) + call register_diags(Time, G, GV, US, CS%IDs, CS%diag) + call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, & CS%use_ALE_algorithm) if (CS%use_ALE_algorithm) then @@ -2391,7 +2390,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & 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) + 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, & @@ -2516,10 +2515,11 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) end subroutine finish_MOM_initialization !> Register certain diagnostics -subroutine register_diags(Time, G, GV, IDs, diag) +subroutine register_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time 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(inout) :: US !< A dimensional unit scaling type type(MOM_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -2535,9 +2535,9 @@ subroutine register_diags(Time, G, GV, IDs, diag) ! Diagnostics of the rapidly varying dynamic state IDs%id_u = register_diag_field('ocean_model', 'u_dyn', diag%axesCuL, Time, & - 'Zonal velocity after the dynamics update', 'm s-1') + 'Zonal velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_v = register_diag_field('ocean_model', 'v_dyn', diag%axesCvL, Time, & - 'Meridional velocity after the dynamics update', 'm s-1') + 'Meridional velocity after the dynamics update', 'm s-1', conversion=US%L_T_to_m_s) IDs%id_h = register_diag_field('ocean_model', 'h_dyn', diag%axesTL, Time, & 'Layer Thickness after the dynamics update', thickness_units, & v_extensive=.true., conversion=H_convert) @@ -2639,7 +2639,11 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & "Height unit conversion factor", "Z meter-1") call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & - "Thickness unit conversion factor", "Z meter-1") + "Thickness unit conversion factor", "H meter-1") + call register_restart_field(US%m_to_Z_restart, "m_to_L", .false., restart_CSp, & + "Length unit conversion factor", "L meter-1") + call register_restart_field(US%s_to_T_restart, "s_to_T", .false., restart_CSp, & + "Time unit conversion factor", "T second-1") end subroutine set_restart_fields @@ -2674,7 +2678,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*US%m_to_Z)) + IgR0 = 1.0 / (Rho_conv * GV%mks_g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif @@ -2692,12 +2696,13 @@ subroutine extract_surface_state(CS, sfc_state) ! local real :: hu, hv ! Thicknesses interpolated to velocity points [H ~> m or kg m-2] - type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing + type(ocean_grid_type), pointer :: G => NULL() !< pointer to a structure containing !! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - real, dimension(:,:,:), pointer :: & - u => NULL(), & !< u : zonal velocity component [m s-1] - v => NULL(), & !< v : meridional velocity component [m s-1] + type(verticalGrid_type), pointer :: GV => NULL() !< structure containing vertical grid info + type(unit_scale_type), pointer :: US => NULL() !< structure containing various unit conversion factors + real, dimension(:,:,:), pointer :: & +! u => NULL(), & !< u : zonal velocity component [m s-1] +! v => NULL(), & !< v : meridional velocity component [m s-1] h => NULL() !< h : layer thickness [H ~> m or kg m-2] real :: depth(SZI_(CS%G)) !< Distance from the surface in depth units [Z ~> m] real :: depth_ml !< Depth over which to average to determine mixed @@ -2708,19 +2713,19 @@ subroutine extract_surface_state(CS, sfc_state) real :: T_freeze !< freezing temperature [degC] real :: delT(SZI_(CS%G)) !< T-T_freeze [degC] logical :: use_temperature !< If true, temp and saln used as state variables. - integer :: i, j, k, is, ie, js, je, nz, numberOfErrors + integer :: i, j, k, is, ie, js, je, nz, numberOfErrors, ig, jg integer :: isd, ied, jsd, jed integer :: iscB, iecB, jscB, jecB, isdB, iedB, jsdB, jedB logical :: localError character(240) :: msg call callTree_enter("extract_surface_state(), MOM.F90") - G => CS%G ; GV => CS%GV + G => CS%G ; GV => CS%GV ; US => CS%US 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 iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB isdB = G%isdB ; iedB = G%iedB; jsdB = G%jsdB ; jedB = G%jedB - u => CS%u ; v => CS%v ; h => CS%h + h => CS%h use_temperature = associated(CS%tv%T) @@ -2754,10 +2759,10 @@ subroutine extract_surface_state(CS, sfc_state) sfc_state%SSS(i,j) = CS%tv%S(i,j,1) enddo ; enddo ; endif do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo else ! (CS%Hmix >= 0.0) @@ -2830,7 +2835,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%v(i,J) = sfc_state%v(i,J) + dh * v(i,J,k) + sfc_state%v(i,J) = sfc_state%v(i,J) + dh * US%L_T_to_m_s * CS%v(i,J,k) depth(i) = depth(i) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2856,7 +2861,7 @@ subroutine extract_surface_state(CS, sfc_state) else dh = 0.0 endif - sfc_state%u(I,j) = sfc_state%u(I,j) + dh * u(I,j,k) + sfc_state%u(I,j) = sfc_state%u(I,j) + dh * US%L_T_to_m_s * CS%u(I,j,k) depth(I) = depth(I) + dh enddo ; enddo ! Calculate the average properties of the mixed layer depth. @@ -2868,10 +2873,10 @@ subroutine extract_surface_state(CS, sfc_state) enddo ! end of j loop else ! Hmix_UV<=0. do j=js,je ; do I=is-1,ie - sfc_state%u(I,j) = u(I,j,1) + sfc_state%u(I,j) = US%L_T_to_m_s * CS%u(I,j,1) enddo ; enddo do J=js-1,je ; do i=is,ie - sfc_state%v(i,J) = v(i,J,1) + sfc_state%v(i,J) = US%L_T_to_m_s * CS%v(i,J,1) enddo ; enddo endif endif ! (CS%Hmix >= 0.0) @@ -2987,18 +2992,22 @@ subroutine extract_surface_state(CS, sfc_state) if (localError) then numberOfErrors=numberOfErrors+1 if (numberOfErrors<9) then ! Only report details for the first few errors + ig = i + G%HI%idg_offset ! Global i-index + jg = j + G%HI%jdg_offset ! Global j-index if (use_temperature) then - write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),8(a,es11.4,x))') & - 'Extreme surface sfc_state detected: i=',i,'j=',j, & - 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & + write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),8(a,es11.4,x))') & + 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & + 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & + 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) else - write(msg(1:240),'(2(a,i4,x),2(a,f8.3,x),6(a,es11.4))') & - 'Extreme surface sfc_state detected: i=',i,'j=',j, & - 'x=',G%geoLonT(i,j), 'y=',G%geoLatT(i,j), & + write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),6(a,es11.4))') & + 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & + 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & + 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & 'D=',bathy_m, 'SSH=',sfc_state%sea_lev(i,j), & 'U-=',sfc_state%u(I-1,j), 'U+=',sfc_state%u(I,j), & 'V-=',sfc_state%v(i,J-1), 'V+=',sfc_state%v(i,J) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index a897e2af13..e044ea5f6d 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -111,17 +111,17 @@ module MOM_CoriolisAdv subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Zonal transport u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Meridional transport v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection [m s-2]. + !! and momentum advection [L T-2 ~> m s-2]. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -129,68 +129,68 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - q, & ! Layer potential vorticity [m-1 s-1]. + q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1]. - Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [m2]. + Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [L2 ~> m2]. real, dimension(SZIB_(G),SZJ_(G)) :: & a, b, c, d ! a, b, c, & d are combinations of the potential vorticities ! surrounding an h grid point. At small scales, a = q/4, - ! b = q/4, etc. All are in [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1], + ! b = q/4, etc. All are in [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1], ! and use the indexing of the corresponding u point. real, dimension(SZI_(G),SZJ_(G)) :: & - Area_h, & ! The ocean area at h points [m2]. Area_h is used to find the + Area_h, & ! The ocean area at h points [L2 ~> m2]. Area_h is used to find the ! average thickness in the denominator of q. 0 for land points. - KE ! Kinetic energy per unit mass [m2 s-2], KE = (u^2 + v^2)/2. + KE ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2], KE = (u^2 + v^2)/2. real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points - ! times the effective areas [H m2 ~> m3 or kg]. - KEx, & ! The zonal gradient of Kinetic energy per unit mass [m s-2], + ! times the effective areas [H L2 ~> m3 or kg]. + KEx, & ! The zonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEx = d/dx KE. - uh_center ! Transport based on arithmetic mean h at u-points [H m2 s-1 ~> m3 s-1 or kg s-1] + uh_center ! Transport based on arithmetic mean h at u-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points - ! times the effective areas [H m2 ~> m3 or kg]. - KEy, & ! The meridonal gradient of Kinetic energy per unit mass [m s-2], + ! times the effective areas [H L2 ~> m3 or kg]. + KEy, & ! The meridonal gradient of Kinetic energy per unit mass [L T-2 ~> m s-2], ! KEy = d/dy KE. - vh_center ! Transport based on arithmetic mean h at v-points [H m2 s-1 ~> m3 s-1 or kg s-1] + vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & uh_min, uh_max, & ! The smallest and largest estimates of the volume vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) - ! [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! [H L2 T-1 ~> m3 s-1 or kg s-1]. ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb ! discretization [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & - dvdx,dudy, &! Contributions to the circulation around q-points [m2 s-1] - abs_vort, & ! Absolute vorticity at q-points [s-1]. - q2, & ! Relative vorticity over thickness [H-1 s-1 ~> m-1 s-1 or m2 kg-1 s-1]. - max_fvq, & ! The maximum or minimum of the - min_fvq, & ! adjacent values of (-u) or v times - max_fuq, & ! the absolute vorticity [m s-2]. - min_fuq ! All are defined at q points. + dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1] + abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1]. + q2, & ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + max_fvq, & ! The maximum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + min_fvq, & ! The minimum of the adjacent values of (-u) times absolute vorticity [L T-2 ~> m s-2]. + max_fuq, & ! The maximum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. + min_fuq ! The minimum of the adjacent values of u times absolute vorticity [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & - PV, & ! A diagnostic array of the potential vorticities [m-1 s-1]. - RV ! A diagnostic array of the relative vorticities [s-1]. - real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [m s-2]. + PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. + RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. + real :: fv1, fv2, fu1, fu2 ! (f+rv)*v or (f+rv)*u [L T-2 ~> m s-2]. real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis - real :: min_fv, min_fu ! accelerations [m s-2], i.e. max(min)_fu(v)q. + real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. real, parameter :: C1_12=1.0/12.0 ! C1_12 = 1/12 real, parameter :: C1_24=1.0/24.0 ! C1_24 = 1/24 - real :: absolute_vorticity ! Absolute vorticity [s-1]. - real :: relative_vorticity ! Relative vorticity [s-1]. + real :: absolute_vorticity ! Absolute vorticity [T-1 ~> s-1]. + real :: relative_vorticity ! Relative vorticity [T-1 ~> s-1]. real :: Ih ! Inverse of thickness [H-1 ~> m-1 or m2 kg-1]. real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells - ! surrounding a q point [H m2 ~> m3 or kg]. + ! surrounding a q point [H L2 ~> m3 or kg]. 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 :: temp1, temp2 ! Temporary variables [m2 s-2]. - real, parameter :: eps_vel=1.0e-10 ! A tiny, positive velocity [m s-1]. + real :: temp1, temp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. + real :: eps_vel ! A tiny, positive velocity [L T-1 ~> m s-1]. - real :: uhc, vhc ! Centered estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: uhm, vhm ! The input estimates of uh and vh [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhc, vhc ! Centered estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: uhm, vhm ! The input estimates of uh and vh [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: c1, c2, c3, slope ! Nondimensional parameters for the Coriolis limiter scheme. real :: Fe_m2 ! Nondimensional temporary variables asssociated with @@ -206,8 +206,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) real :: Heff1, Heff2 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: Heff3, Heff4 ! Temporary effective H at U or V points [H ~> m or kg m-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. - real :: UHeff, VHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: QUHeff,QVHeff ! More temporary variables [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: UHeff, VHeff ! More temporary variables [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: QUHeff,QVHeff ! More temporary variables [H L2 T-1 s-1 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz ! To work, the following fields must be set outside of the usual @@ -220,6 +220,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, 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 ; nz = G%ke h_neglect = GV%H_subroundoff + eps_vel = 1.0e-10*US%m_s_to_L_T h_tiny = GV%Angstrom_H ! Perhaps this should be set to h_neglect instead. !$OMP parallel do default(private) shared(Isq,Ieq,Jsq,Jeq,G,Area_h) @@ -256,14 +257,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) !$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,CS,AD,Area_h,Area_q,& !$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,h_neglect,h_tiny,OBC) do k=1,nz + ! Here the second order accurate layer potential vorticities, q, ! are calculated. hq is second order accurate in space. Relative ! vorticity is second order accurate everywhere with free slip b.c.s, ! but only first order accurate at boundaries with no slip b.c.s. ! First calculate the contributions to the circulation around the q-point. do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 - dvdx(I,J) = v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J) - dudy(I,J) = u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j) + dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J)) + dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2 hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k)) @@ -406,13 +408,11 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1 if (CS%no_slip ) then - relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + relative_vorticity = (2.0-G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) else - relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * & - G%IareaBu(I,J) + relative_vorticity = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J) endif - absolute_vorticity = US%s_to_T*G%CoriolisBu(I,J) + relative_vorticity + absolute_vorticity = G%CoriolisBu(I,J) + relative_vorticity Ih = 0.0 if (Area_q(i,j) > 0.0) then hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J)) @@ -423,10 +423,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) Ih_q(I,J) = Ih if (CS%bound_Coriolis) then - fv1 = absolute_vorticity*v(i+1,J,k) - fv2 = absolute_vorticity*v(i,J,k) - fu1 = -absolute_vorticity*u(I,j+1,k) - fu2 = -absolute_vorticity*u(I,j,k) + fv1 = absolute_vorticity * v(i+1,J,k) + fv2 = absolute_vorticity * v(i,J,k) + fu1 = -absolute_vorticity * u(I,j+1,k) + fu2 = -absolute_vorticity * u(I,j,k) if (fv1 > fv2) then max_fvq(I,J) = fv1 ; min_fvq(I,J) = fv2 else @@ -565,7 +565,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) endif ! Calculate KE and the gradient of KE - call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) + call gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) ! Calculate the tendencies of zonal velocity due to the Coriolis ! force and momentum advection. On a Cartesian grid, this is @@ -610,40 +610,35 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) (CS%Coriolis_Scheme == AL_BLEND)) then ! (Global) Energy and (Local) Enstrophy conserving, Arakawa & Hsu 1990 do j=js,je ; do I=Isq,Ieq - CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + & - c(I,j) * vh(i,J-1,k)) & - + (b(I,j) * vh(i,J,k) + & - d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) + CAu(I,j,k) = ((a(I,j) * vh(i+1,J,k) + c(I,j) * vh(i,J-1,k)) + & + (b(I,j) * vh(i,J,k) + d(I,j) * vh(i+1,J-1,k))) * G%IdxCu(I,j) enddo ; enddo elseif (CS%Coriolis_Scheme == ROBUST_ENSTRO) then ! An enstrophy conserving scheme robust to vanishing layers ! Note: Heffs are in lieu of h_at_v that should be returned by the ! continuity solver. AJA do j=js,je ; do I=Isq,Ieq - Heff1 = abs(vh(i,J,k)*G%IdxCv(i,J))/(eps_vel+abs(v(i,J,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i,j+1,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i,j+1,k))) - Heff2 = abs(vh(i,J-1,k)*G%IdxCv(i,J-1))/(eps_vel+abs(v(i,J-1,k))) - Heff2 = max(Heff2,min(h(i,j-1,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i,j-1,k),h(i,j,k))) - Heff3 = abs(vh(i+1,J,k)*G%IdxCv(i+1,J))/(eps_vel+abs(v(i+1,J,k))) - Heff3 = max(Heff3,min(h(i+1,j,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i+1,j,k),h(i+1,j+1,k))) - Heff4 = abs(vh(i+1,J-1,k)*G%IdxCv(i+1,J-1))/(eps_vel+abs(v(i+1,J-1,k))) - Heff4 = max(Heff4,min(h(i+1,j-1,k),h(i+1,j,k))) - Heff4 = min(Heff4,max(h(i+1,j-1,k),h(i+1,j,k))) + Heff1 = abs(vh(i,J,k) * G%IdxCv(i,J)) / (eps_vel+abs(v(i,J,k))) + Heff1 = max(Heff1, min(h(i,j,k),h(i,j+1,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i,j+1,k))) + Heff2 = abs(vh(i,J-1,k) * G%IdxCv(i,J-1)) / (eps_vel+abs(v(i,J-1,k))) + Heff2 = max(Heff2, min(h(i,j-1,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i,j-1,k),h(i,j,k))) + Heff3 = abs(vh(i+1,J,k) * G%IdxCv(i+1,J)) / (eps_vel+abs(v(i+1,J,k))) + Heff3 = max(Heff3, min(h(i+1,j,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i+1,j,k),h(i+1,j+1,k))) + Heff4 = abs(vh(i+1,J-1,k) * G%IdxCv(i+1,J-1)) / (eps_vel+abs(v(i+1,J-1,k))) + Heff4 = max(Heff4, min(h(i+1,j-1,k),h(i+1,j,k))) + Heff4 = min(Heff4, max(h(i+1,j-1,k),h(i+1,j,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then CAu(I,j,k) = 0.5*(abs_vort(I,J)+abs_vort(I,J-1)) * & - ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) / & + (h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) * G%IdxCu(I,j) elseif (CS%PV_Adv_Scheme == PV_ADV_UPWIND1) then - VHeff = ((vh(i ,J ,k)+vh(i+1,J-1,k)) + & - (vh(i ,J-1,k)+vh(i+1,J ,k)) ) + VHeff = ((vh(i,J,k) + vh(i+1,J-1,k)) + (vh(i,J-1,k) + vh(i+1,J,k)) ) QVHeff = 0.5*( (abs_vort(I,J)+abs_vort(I,J-1))*VHeff & -(abs_vort(I,J)-abs_vort(I,J-1))*abs(VHeff) ) - CAu(I,j,k) = QVHeff / & - (h_tiny +((Heff1+Heff4) +(Heff2+Heff3)) ) * G%IdxCu(I,j) + CAu(I,j,k) = (QVHeff / ( h_tiny + ((Heff1+Heff4) + (Heff2+Heff3)) ) ) * G%IdxCu(I,j) endif enddo ; enddo endif @@ -657,8 +652,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) if (CS%bound_Coriolis) then do j=js,je ; do I=Isq,Ieq - max_fv = MAX(max_fvq(I,J),max_fvq(I,J-1)) - min_fv = MIN(min_fvq(I,J),min_fvq(I,J-1)) + max_fv = MAX(max_fvq(I,J), max_fvq(I,J-1)) + min_fv = MIN(min_fvq(I,J), min_fvq(I,J-1)) ! CAu(I,j,k) = min( CAu(I,j,k), max_fv ) ! CAu(I,j,k) = max( CAu(I,j,k), min_fv ) if (CAu(I,j,k) > max_fv) then @@ -699,7 +694,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) else temp2 = q(I,J) * (uh_min(i,j)+uh_min(i,j+1)) endif - CAv(i,J,k) = - 0.25 * G%IdyCv(i,J) * (temp1 + temp2) + CAv(i,J,k) = -0.25 * G%IdyCv(i,J) * (temp1 + temp2) enddo ; enddo else ! Energy conserving scheme, Sadourny 1975 @@ -729,18 +724,18 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS) ! Note: Heffs are in lieu of h_at_u that should be returned by the ! continuity solver. AJA do J=Jsq,Jeq ; do i=is,ie - Heff1 = abs(uh(I,j,k)*G%IdyCu(I,j))/(eps_vel+abs(u(I,j,k))) - Heff1 = max(Heff1,min(h(i,j,k),h(i+1,j,k))) - Heff1 = min(Heff1,max(h(i,j,k),h(i+1,j,k))) - Heff2 = abs(uh(I-1,j,k)*G%IdyCu(I-1,j))/(eps_vel+abs(u(I-1,j,k))) - Heff2 = max(Heff2,min(h(i-1,j,k),h(i,j,k))) - Heff2 = min(Heff2,max(h(i-1,j,k),h(i,j,k))) - Heff3 = abs(uh(I,j+1,k)*G%IdyCu(I,j+1))/(eps_vel+abs(u(I,j+1,k))) - Heff3 = max(Heff3,min(h(i,j+1,k),h(i+1,j+1,k))) - Heff3 = min(Heff3,max(h(i,j+1,k),h(i+1,j+1,k))) - Heff4 = abs(uh(I-1,j+1,k)*G%IdyCu(I-1,j+1))/(eps_vel+abs(u(I-1,j+1,k))) - Heff4 = max(Heff4,min(h(i-1,j+1,k),h(i,j+1,k))) - Heff4 = min(Heff4,max(h(i-1,j+1,k),h(i,j+1,k))) + Heff1 = abs(uh(I,j,k) * G%IdyCu(I,j)) / (eps_vel+abs(u(I,j,k))) + Heff1 = max(Heff1, min(h(i,j,k),h(i+1,j,k))) + Heff1 = min(Heff1, max(h(i,j,k),h(i+1,j,k))) + Heff2 = abs(uh(I-1,j,k) * G%IdyCu(I-1,j)) / (eps_vel+abs(u(I-1,j,k))) + Heff2 = max(Heff2, min(h(i-1,j,k),h(i,j,k))) + Heff2 = min(Heff2, max(h(i-1,j,k),h(i,j,k))) + Heff3 = abs(uh(I,j+1,k) * G%IdyCu(I,j+1)) / (eps_vel+abs(u(I,j+1,k))) + Heff3 = max(Heff3, min(h(i,j+1,k),h(i+1,j+1,k))) + Heff3 = min(Heff3, max(h(i,j+1,k),h(i+1,j+1,k))) + Heff4 = abs(uh(I-1,j+1,k) * G%IdyCu(I-1,j+1)) / (eps_vel+abs(u(I-1,j+1,k))) + Heff4 = max(Heff4, min(h(i-1,j+1,k),h(i,j+1,k))) + Heff4 = min(Heff4, max(h(i-1,j+1,k),h(i,j+1,k))) if (CS%PV_Adv_Scheme == PV_ADV_CENTERED) then CAv(i,J,k) = - 0.5*(abs_vort(I,J)+abs_vort(I-1,J)) * & ((uh(I ,j ,k)+uh(I-1,j+1,k)) + & @@ -838,23 +833,24 @@ end subroutine CorAdCalc !> Calculates the acceleration due to the gradient of kinetic energy. -subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) +subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocen grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy [m2 s-2] + real, dimension(SZI_(G) ,SZJ_(G) ), intent(out) :: KE !< Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G) ), intent(out) :: KEx !< Zonal acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] real, dimension(SZI_(G) ,SZJB_(G)), intent(out) :: KEy !< Meridional acceleration due to kinetic - !! energy gradient [m s-2] + !! energy gradient [L T-2 ~> m s-2] integer, intent(in) :: k !< Layer number to calculate for type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), pointer :: CS !< Control structure for MOM_CoriolisAdv ! Local variables - real :: um, up, vm, vp ! Temporary variables [m s-1]. - real :: um2, up2, vm2, vp2 ! Temporary variables [m2 s-2]. - real :: um2a, up2a, vm2a, vp2a ! Temporary variables [m4 s-2]. + real :: um, up, vm, vp ! Temporary variables [L T-1 ~> m s-1]. + real :: um2, up2, vm2, vp2 ! Temporary variables [L2 T-2 ~> m2 s-2]. + real :: um2a, up2a, vm2a, vp2a ! Temporary variables [L4 T-2 ~> m4 s-2]. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -867,11 +863,10 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) ! identified in Arakawa & Lamb 1982 as important for KE conservation. It ! also includes the possibility of partially-blocked tracer cell faces. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) & - +G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) & - +( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) & - +G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) & - )*0.25*G%IareaT(i,j) + KE(i,j) = ( ( G%areaCu( I ,j)*(u( I ,j,k)*u( I ,j,k)) + & + G%areaCu(I-1,j)*(u(I-1,j,k)*u(I-1,j,k)) ) + & + ( G%areaCv(i, J )*(v(i, J ,k)*v(i, J ,k)) + & + G%areaCv(i,J-1)*(v(i,J-1,k)*v(i,J-1,k)) ) )*0.25*G%IareaT(i,j) enddo ; enddo elseif (CS%KE_Scheme == KE_SIMPLE_GUDONOV) then ! The following discretization of KE is based on the one-dimensinal Gudonov @@ -922,9 +917,11 @@ subroutine gradKE(u, v, h, KE, KEx, KEy, k, OBC, G, CS) end subroutine gradKE !> Initializes the control structure for coriolisadv_cs -subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) +subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + 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 type(param_file_type), intent(in) :: param_file !< Runtime parameter handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(accel_diag_ptrs), target, intent(inout) :: AD !< Strorage for acceleration diagnostics @@ -937,7 +934,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) character(len=400) :: mesg integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + 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 if (associated(CS)) then @@ -1068,25 +1065,25 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) end select CS%id_rv = register_diag_field('ocean_model', 'RV', diag%axesBL, Time, & - 'Relative Vorticity', 's-1') + 'Relative Vorticity', 's-1', conversion=US%s_to_T) CS%id_PV = register_diag_field('ocean_model', 'PV', diag%axesBL, Time, & - 'Potential Vorticity', 'm-1 s-1') + 'Potential Vorticity', 'm-1 s-1', conversion=GV%m_to_H*US%s_to_T) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & - 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Zonal Acceleration from Grad. Kinetic Energy', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_gKEu > 0) call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) CS%id_gKEv = register_diag_field('ocean_model', 'gKEv', diag%axesCvL, Time, & - 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 s-2') + 'Meridional Acceleration from Grad. Kinetic Energy', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_gKEv > 0) call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) CS%id_rvxu = register_diag_field('ocean_model', 'rvxu', diag%axesCvL, Time, & - 'Meridional Acceleration from Relative Vorticity', 'm-1 s-2') + 'Meridional Acceleration from Relative Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxu > 0) call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, & - 'Zonal Acceleration from Relative Vorticity', 'm-1 s-2') + 'Zonal Acceleration from Relative Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) end subroutine CoriolisAdv_init diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 183817bf42..5579b2311f 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -52,9 +52,9 @@ subroutine PressureForce(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbce, e 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 real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu !< Zonal pressure force acceleration [m s-2] + intent(out) :: PFu !< Zonal pressure force acceleration [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv !< Meridional pressure force acceleration [m s-2] + intent(out) :: PFv !< Meridional pressure force acceleration [L T-2 ~> m s-2] type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), & diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 42c08b8364..9bb0a02606 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -40,9 +40,10 @@ module MOM_PressureForce_Mont type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. - real, pointer :: PFu_bc(:,:,:) => NULL() !< Accelerations due to pressure - real, pointer :: PFv_bc(:,:,:) => NULL() !< gradients deriving from density - !! gradients within layers [m s-2]. + real, pointer :: PFu_bc(:,:,:) => NULL() !< Zonal accelerations due to pressure gradients + !! deriving from density gradients within layers [L T-2 ~> m s-2]. + real, pointer :: PFv_bc(:,:,:) => NULL() !< 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 !!@} @@ -67,9 +68,9 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, [H ~> kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [Pa]. @@ -81,7 +82,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. alpha_star, & ! Compression adjusted specific volume [m3 kg-1]. dz_geo ! The change in geopotential across a layer [m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: p ! Interface pressure [Pa]. @@ -106,12 +107,12 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. geopot_bot ! Bottom geopotential relative to time-mean sea level, - ! including any tidal contributions [m2 s-2]. + ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: rho_in_situ(SZI_(G)) !In-situ density of a layer [kg m-3]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] + ! compensated density gradients [L T-2 ~> m s-2] real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -147,7 +148,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb "can no longer be used with a compressible EOS. Use #define ANALYTIC_FV_PGF.") endif - I_gEarth = 1.0 / GV%g_Earth + I_gEarth = 1.0 / (US%L_T_to_m_s**2 * GV%g_Earth) dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -258,20 +259,20 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_star(i,j,nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_star(i,j,nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * (alpha_star(i,j,k) - alpha_star(i,j,k+1)) enddo ; enddo enddo else ! not use_EOS !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - M(i,j,nz) = geopot_bot(i,j) + p(i,j,nz+1) * alpha_Lay(nz) + M(i,j,nz) = geopot_bot(i,j) + US%m_s_to_L_T**2*p(i,j,nz+1) * alpha_Lay(nz) enddo do k=nz-1,1,-1 ; do i=Isq,Ieq+1 - M(i,j,k) = M(i,j,k+1) + p(i,j,K+1) * dalpha_int(K+1) + M(i,j,k) = M(i,j,k+1) + US%m_s_to_L_T**2*p(i,j,K+1) * dalpha_int(K+1) enddo ; enddo enddo endif ! use_EOS @@ -294,11 +295,11 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! enddo ; enddo ! if (use_EOS) then ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * (alpha_star(i,j,k-1) - alpha_star(i,j,k)) ! enddo ; enddo ; enddo ! else ! not use_EOS ! do k=2,nz ; do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 -! M(i,j,k) = M(i,j,k-1) - p(i,j,K) * dalpha_int(K) +! M(i,j,k) = M(i,j,k-1) - US%m_s_to_L_T**2*p(i,j,K) * dalpha_int(K) ! enddo ; enddo ; enddo ! endif ! use_EOS @@ -306,7 +307,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! Note that ddM/dPb = alpha_star(i,j,1) if (present(pbce)) then - call Set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce, alpha_star) + call Set_pbce_nonBouss(p, tv_tmp, G, GV, US, CS%GFS_scale, pbce, alpha_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -319,14 +320,14 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo do j=js,je ; do I=Isq,Ieq ! PFu_bc = p* grad alpha* - PFu_bc = (alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & + PFu_bc = US%m_s_to_L_T**2*(alpha_star(i+1,j,k) - alpha_star(i,j,k)) * (G%IdxCu(I,j) * & ((dp_star(i,j) * dp_star(i+1,j) + (p(i,j,K) * dp_star(i+1,j) + & p(i+1,j,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i+1,j)))) PFu(I,j,k) = -(M(i+1,j,k) - M(i,j,k)) * G%IdxCu(I,j) + PFu_bc if (associated(CS%PFu_bc)) CS%PFu_bc(i,j,k) = PFu_bc enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - PFv_bc = (alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & + PFv_bc = US%m_s_to_L_T**2*(alpha_star(i,j+1,k) - alpha_star(i,j,k)) * (G%IdyCv(i,J) * & ((dp_star(i,j) * dp_star(i,j+1) + (p(i,j,K) * dp_star(i,j+1) + & p(i,j+1,K) * dp_star(i,j))) / (dp_star(i,j) + dp_star(i,j+1)))) PFv(i,J,k) = -(M(i,j+1,k) - M(i,j,k)) * G%IdyCv(i,J) + PFv_bc @@ -365,9 +366,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s2]. + !! (equal to -dM/dy) [L T-2 ~> m s2]. type(PressureForce_Mont_CS), pointer :: CS !< Control structure for Montgomery potential PGF real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean or !! atmosphere-ocean [Pa]. @@ -377,7 +378,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - M, & ! The Montgomery potential, M = (p/rho + gz) [m2 s-2]. + M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the ! corrected e times (G_Earth/Rho0) [m2 Z-1 s-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: e ! Interface height in m. @@ -400,10 +401,9 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [Pa] (usually 2e7 Pa = 2000 dbar). real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: PFu_bc, PFv_bc ! The pressure gradient force due to along-layer - ! compensated density gradients [m s-2] -! real :: dr ! Temporary variables. + ! compensated density gradients [L T-2 ~> m s-2] real :: h_neglect ! A thickness 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. @@ -520,7 +520,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = CS%GFS_scale * (rho_star(i,j,1) * e(i,j,1)) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + (rho_star(i,j,k) - rho_star(i,j,k-1)) * e(i,j,K) @@ -531,7 +531,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, do j=Jsq,Jeq+1 do i=Isq,Ieq+1 M(i,j,1) = GV%g_prime(1) * e(i,j,1) - if (use_p_atm) M(i,j,1) = M(i,j,1) + p_atm(i,j) * I_Rho0 + if (use_p_atm) M(i,j,1) = M(i,j,1) + US%m_s_to_L_T**2*p_atm(i,j) * I_Rho0 enddo do k=2,nz ; do i=Isq,Ieq+1 M(i,j,k) = M(i,j,k-1) + GV%g_prime(K) * e(i,j,K) @@ -540,7 +540,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, endif ! use_EOS if (present(pbce)) then - call Set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce, rho_star) + call Set_pbce_Bouss(e, tv_tmp, G, GV, US, CS%Rho0, CS%GFS_scale, pbce, rho_star) endif ! Calculate the pressure force. On a Cartesian grid, @@ -603,11 +603,12 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. -subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) +subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height [Z ~> m]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: Rho0 !< The "Boussinesq" ocean density [kg m-3]. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of @@ -618,7 +619,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: rho_star !< The layer densities (maybe compressibility - !! compensated), times g/rho_0 [m2 Z-1 s-2 ~> m s-2]. + !! compensated), times g/rho_0 [L2 Z-1 T-2 ~> m s-2]. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer thicknesses [H-1 ~> m-1 or m2 kg-1]. @@ -628,7 +629,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. real :: dR_dS(SZI_(G)) ! Partial derivative of density with salinity [kg m-3 ppt-1]. real :: rho_in_situ(SZI_(G)) !In-situ density at the top of a layer [kg m-3]. - real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + real :: G_Rho0 ! A scaled version of g_Earth / Rho0 [L2 m3 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0xG ! g_Earth * Rho0 [kg s-2 m-1 Z-1 ~> kg s-2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using ! an equation of state. @@ -638,7 +639,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, Rho0, GFS_scale, pbce, rho_star) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke - Rho0xG = Rho0*GV%g_Earth + Rho0xG = Rho0*US%L_T_to_m_s**2 * 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 @@ -703,24 +704,25 @@ end subroutine Set_pbce_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the column mass. -subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) +subroutine Set_pbce_nonBouss(p, tv, G, GV, US, GFS_scale, pbce, alpha_star) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: p !< Interface pressures [Pa]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, intent(in) :: GFS_scale !< Ratio between gravity applied to top !! interface and the gravitational acceleration of !! the planet [nondim]. Usually this ratio is 1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due !! to free surface height anomalies - !! [m2 H-1 s-2 ~> m4 kg-2 s-2]. + !! [L2 H-1 T-2 ~> m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: alpha_star !< The layer specific volumes !! (maybe compressibility compensated) [m3 kg-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & dpbce, & ! A barotropic correction to the pbce to enable the use of - ! a reduced gravity form of the equations [m4 s-2 kg-1]. - C_htot ! dP_dH divided by the total ocean pressure [m2 kg-1]. + ! a reduced gravity form of the equations [L2 H-1 T-2 ~> m4 kg-1 s-2]. + C_htot ! dP_dH divided by the total ocean pressure [Z2 s2 m-2 T-2 H-1 ~> m2 kg-1]. real :: T_int(SZI_(G)) ! Interface temperature [degC]. real :: S_int(SZI_(G)) ! Interface salinity [ppt]. real :: dR_dT(SZI_(G)) ! Partial derivative of density with temperature [kg m-3 degC-1]. @@ -728,7 +730,8 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) real :: rho_in_situ(SZI_(G)) ! In-situ density at an interface [kg m-3]. real :: alpha_Lay(SZK_(G)) ! The specific volume of each layer [kg m-3]. real :: dalpha_int(SZK_(G)+1) ! The change in specific volume across each interface [kg m-3]. - real :: dP_dH ! A factor that converts from thickness to pressure [Pa H-1 ~> Pa m2 kg-1]. + real :: dP_dH ! A factor that converts from thickness to pressure times other dimensional + ! conversion factors [Z2 s2 Pa m-2 T-2 H-1 ~> Pa m2 kg-1]. real :: dp_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [Pa]. logical :: use_EOS ! If true, density is calculated from T & S using @@ -739,8 +742,8 @@ subroutine Set_pbce_nonBouss(p, tv, G, GV, GFS_scale, pbce, alpha_star) use_EOS = associated(tv%eqn_of_state) - dP_dH = GV%H_to_Pa - dp_neglect = dP_dH * GV%H_subroundoff + dP_dH = US%m_s_to_L_T**2*GV%H_to_Pa + dp_neglect = GV%H_to_Pa * GV%H_subroundoff do k=1,nz ; alpha_Lay(k) = 1.0 / GV%Rlay(k) ; enddo do k=2,nz ; dalpha_int(K) = alpha_Lay(k-1) - alpha_Lay(k) ; enddo @@ -822,10 +825,11 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_Mont_CS), pointer :: CS !< Montgomery PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure + ! Local variables logical :: use_temperature, use_EOS -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl ! This module's name. if (associated(CS)) then @@ -854,9 +858,9 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ if (use_EOS) then CS%id_PFu_bc = register_diag_field('ocean_model', 'PFu_bc', diag%axesCuL, Time, & - 'Density Gradient Zonal Pressure Force Accel.', "meter second-2") + 'Density Gradient Zonal Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) CS%id_PFv_bc = register_diag_field('ocean_model', 'PFv_bc', diag%axesCvL, Time, & - 'Density Gradient Meridional Pressure Force Accel.', "meter second-2") + 'Density Gradient Meridional Pressure Force Accel.', "meter second-2", conversion=US%L_T2_to_m_s2) if (CS%id_PFu_bc > 0) then call safe_alloc_ptr(CS%PFu_bc,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%PFu_bc(:,:,:) = 0.0 diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index e68a699b7a..f84b8e780e 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, pbc 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 or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -105,8 +105,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p 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 ~> kg/m2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -140,7 +140,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM, & ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! 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 ! interface atop a layer [m2 s-2]. @@ -195,7 +195,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -341,14 +341,14 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p rho_in_situ, Isq, Ieq-Isq+2, tv%eqn_of_state) do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * & + dM(i,j) = (CS%GFS_scale - 1.0) * US%m_s_to_L_T**2 * & (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif @@ -384,8 +384,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i+1,j)*dp(i+1,j) + intp_dza(i+1,j,k))) + & ((dp(i+1,j) - dp(i,j)) * intx_za(I,j) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp(i,j) + dp(i+1,j)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & + ((dp(i,j) + dp(i+1,j)) + dp_neglect)) enddo ; enddo !$OMP parallel do default(shared) do J=Jsq,Jeq ; do i=is,ie @@ -394,8 +394,8 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p (za(i,j+1)*dp(i,j+1) + intp_dza(i,j+1,k))) + & ((dp(i,j+1) - dp(i,j)) * inty_za(i,J) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp(i,j) + dp(i,j+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & + ((dp(i,j) + dp(i,j+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then @@ -412,7 +412,7 @@ subroutine PressureForce_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, US, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -448,8 +448,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at 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(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -466,7 +466,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! 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 ! density near-surface layer [kg m-3]. @@ -502,8 +502,8 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: I_Rho0 ! 1/Rho0 [m3 kg-1]. - real :: G_Rho0 ! G_Earth / Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. + real :: G_Rho0 ! G_Earth / Rho0 in [L2 m5 Z-1 T-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. logical :: use_p_atm ! If true, use the atmospheric pressure. @@ -531,9 +531,9 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth - G_Rho0 = g_Earth_z/GV%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth + G_Rho0 = GV%g_Earth/GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -757,7 +757,7 @@ subroutine PressureForce_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_at endif if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, US, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -791,8 +791,8 @@ subroutine PressureForce_AFV_init(Time, G, GV, US, param_file, diag, CS, tides_C type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE diff --git a/src/core/MOM_PressureForce_blocked_AFV.F90 b/src/core/MOM_PressureForce_blocked_AFV.F90 index 4b602373e7..773bcefc1d 100644 --- a/src/core/MOM_PressureForce_blocked_AFV.F90 +++ b/src/core/MOM_PressureForce_blocked_AFV.F90 @@ -69,8 +69,8 @@ subroutine PressureForce_blk_AFV(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm, 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 or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -105,8 +105,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, 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 ~> kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean !! or atmosphere-ocean interface [Pa]. @@ -191,7 +191,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, dp_neglect = GV%H_to_Pa * GV%H_subroundoff alpha_ref = 1.0/CS%Rho0 - g_Earth_z = GV%g_Earth + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth I_gEarth = 1.0 / g_Earth_z if (use_p_atm) then @@ -307,14 +307,14 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/rho_in_situ(i) - alpha_ref) + za(i,j)) enddo enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 dM(i,j) = (CS%GFS_scale - 1.0) * & - (p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) + US%m_s_to_L_T**2*(p(i,j,1)*(1.0/GV%Rlay(1) - alpha_ref) + za(i,j)) enddo ; enddo endif ! else @@ -365,8 +365,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib+1,jb)*dp_bk(ib+1,jb) + intp_dza(i+1,j,k))) + & ((dp_bk(ib+1,jb) - dp_bk(ib,jb)) * intx_za_bk(Ib,jb) - & (p(i+1,j,K) - p(i,j,K)) * intx_dza(I,j,k))) * & - (2.0*G%IdxCu(I,j) / ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdxCu(I,j) / & + ((dp_bk(ib,jb) + dp_bk(ib+1,jb)) + dp_neglect)) enddo ; enddo do Jb=Jsq_bk,Jeq_bk ; do ib=is_bk,ie_bk i = ib+ioff_bk ; J = Jb+joff_bk @@ -375,8 +375,8 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, (za_bk(ib,jb+1)*dp_bk(ib,jb+1) + intp_dza(i,j+1,k))) + & ((dp_bk(ib,jb+1) - dp_bk(ib,jb)) * inty_za_bk(ib,Jb) - & (p(i,j+1,K) - p(i,j,K)) * inty_dza(i,J,k))) * & - (2.0*G%IdyCv(i,J) / ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + & - dp_neglect)) + (US%m_s_to_L_T**2 * 2.0*G%IdyCv(i,J) / & + ((dp_bk(ib,jb) + dp_bk(ib,jb+1)) + dp_neglect)) enddo ; enddo if (CS%GFS_scale < 1.0) then @@ -392,7 +392,7 @@ subroutine PressureForce_blk_AFV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, enddo if (present(pbce)) then - call set_pbce_nonBouss(p, tv_tmp, G, GV, CS%GFS_scale, pbce) + call set_pbce_nonBouss(p, tv_tmp, G, GV, US, CS%GFS_scale, pbce) endif if (present(eta)) then @@ -429,8 +429,8 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, 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 or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [m s-2] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [m s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: PFu !< Zonal acceleration [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: PFv !< Meridional acceleration [L T-2 ~> m s-2] type(PressureForce_blk_AFV_CS), pointer :: CS !< Finite volume PGF control structure type(ALE_CS), pointer :: ALE_CSp !< ALE control structure real, dimension(:,:), optional, pointer :: p_atm !< The pressure at the ice-ocean @@ -447,7 +447,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to - ! account for a reduced gravity model [m2 s-2]. + ! 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 ! density near-surface layer [kg m-3]. @@ -482,7 +482,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, real :: p0(SZI_(G)) ! An array of zeros to use for pressure [Pa]. 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_Rho0 ! 1/Rho0 [m3 kg-1]. + real :: I_Rho0 ! 1/Rho0 times unit scaling factors [L2 m kg-1 s2 T-2 ~> m3 kg-1]. real :: g_Earth_z ! A scaled version of g_Earth [m2 Z-1 s-2 ~> m s-2]. real :: G_Rho0 ! G_Earth / Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. real :: Rho_ref ! The reference density [kg m-3]. @@ -515,9 +515,9 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff * GV%H_to_Z - I_Rho0 = 1.0/GV%Rho0 - g_Earth_z = GV%g_Earth - G_Rho0 = g_Earth_z / GV%Rho0 + I_Rho0 = US%m_s_to_L_T**2 / GV%Rho0 + g_Earth_z = US%L_T_to_m_s**2 * GV%g_Earth + G_Rho0 = GV%g_Earth / GV%Rho0 rho_ref = CS%Rho0 if (CS%tides) then @@ -749,7 +749,7 @@ subroutine PressureForce_blk_AFV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, enddo if (present(pbce)) then - call set_pbce_Bouss(e, tv_tmp, G, GV, CS%Rho0, CS%GFS_scale, pbce) + call set_pbce_Bouss(e, tv_tmp, G, GV, US, CS%Rho0, CS%GFS_scale, pbce) endif if (present(eta)) then diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 33450e8a3d..8d48ebbb0b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -65,18 +65,18 @@ module MOM_barotropic !> The barotropic stepping open boundary condition type type, private :: BT_OBC_type - real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [m s-1]. - real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [m s-1]. + real, dimension(:,:), pointer :: Cg_u => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. + real, dimension(:,:), pointer :: Cg_v => NULL() !< The external wave speed at u-points [L T-1 ~> m s-1]. real, dimension(:,:), pointer :: H_u => NULL() !< The total thickness at the u-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: H_v => NULL() !< The total thickness at the v-points [H ~> m or kg m-2]. real, dimension(:,:), pointer :: uhbt => NULL() !< The zonal barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: vhbt => NULL() !< The meridional barotropic thickness fluxes specified - !! for open boundary conditions (if any) [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! for open boundary conditions (if any) [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(:,:), pointer :: ubt_outer => NULL() !< The zonal velocities just outside the domain, - !! as set by the open boundary conditions [m s-1]. + !! as set by the open boundary conditions [L T-1 ~> m s-1]. real, dimension(:,:), pointer :: vbt_outer => NULL() !< The meridional velocities just outside the domain, - !! as set by the open boundary conditions [m s-1]. + !! as set by the open boundary conditions [L T-1 ~> m s-1]. real, dimension(:,:), pointer :: eta_outer_u => NULL() !< The surface height outside of the domain !! at a u-point with an open boundary condition [H ~> m or kg m-2]. real, dimension(:,:), pointer :: eta_outer_v => NULL() !< The surface height outside of the domain @@ -99,59 +99,59 @@ module MOM_barotropic !> The barotropic stepping control stucture type, public :: barotropic_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: frhatu - !< The fraction of the total column thickness interpolated to u grid points in each layer, nondim. + !< The fraction of the total column thickness interpolated to u grid points in each layer [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv - !< The fraction of the total column thickness interpolated to v grid points in each layer, nondim. + !< 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]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow - !! [H s-1 ~> m s-1 or kg m-2 s-1]. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial - !! condition for the next call to btstep [m s-1]. + !! condition for the next call to btstep [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: ubtav - !< The barotropic zonal velocity averaged over the baroclinic time step [m s-1]. + !< The barotropic zonal velocity averaged over the baroclinic time step [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: IDatv !< Inverse of the basin depth at v grid points [Z-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: lin_drag_v !< A spatially varying linear drag coefficient acting on the zonal barotropic flow - !! [H s-1 ~> m s-1 or kg m-2 s-1]. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt_IC !< The barotropic solvers estimate of the zonal transport as the initial condition for - !! the next call to btstep [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! the next call to btstep [H L2 T-1 ~> m3 s-1 or kg s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbt_IC !< The barotropic solvers estimate of the zonal velocity that will be the initial - !! condition for the next call to btstep [m s-1]. + !! condition for the next call to btstep [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vbtav - !< The barotropic meridional velocity averaged over the baroclinic time step [m s-1]. + !< The barotropic meridional velocity averaged over the baroclinic time step [L T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor !< The difference between the free surface height from the barotropic calculation and the sum !! of the layer thicknesses. This difference is imposed as a forcing term in the barotropic !! calculation over a baroclinic timestep [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_cor_bound !< A limit on the rate at which eta_cor can be applied while avoiding instability - !! [H s-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. + !! [H T-1 ~> m s-1 or kg m-2 s-1]. This is only used if CS%bound_BT_corr is true. real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: & ua_polarity, & !< Test vector components for checking grid polarity. va_polarity, & !< Test vector components for checking grid polarity. bathyT !< A copy of bathyT (ocean bottom depth) with wide halos [Z ~> m] real ALLOCABLE_, dimension(NIMEMW_,NJMEMW_) :: IareaT !< This is a copy of G%IareaT with wide halos, but will - !! still utilize the macro IareaT when referenced, m-2. + !! 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]. - dy_Cu, & !< A copy of G%dy_Cu with wide halos [m]. - IdxCu !< A copy of G%IdxCu with wide halos [m-1]. + 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]. - dx_Cv, & !< A copy of G%dx_Cv with wide halos [m]. - IdyCv !< A copy of G%IdyCv with wide halos [m-1]. + 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_) :: & - q_D !< f / D at PV points [Z-1 s-1 ~> m-1 s-1]. + q_D !< f / D at PV points [Z-1 T-1 ~> m-1 s-1]. real, dimension(:,:,:), pointer :: frhatu1 => NULL() !< Predictor step values of frhatu stored for diagnostics. real, dimension(:,:,:), pointer :: frhatv1 => NULL() !< Predictor step values of frhatv stored for diagnostics. @@ -164,10 +164,10 @@ module MOM_barotropic real :: dtbt_fraction !< The fraction of the maximum time-step that !! should used. The default is 0.98. real :: dtbt_max !< The maximum stable barotropic time step [s]. - real :: dt_bt_filter !< The time-scale over which the barotropic mode - !! solutions are filtered [s]. This can never - !! be taken to be longer than 2*dt. The default, 0, - !! applies no filtering. + real :: dt_bt_filter !< The time-scale over which the barotropic mode solutions are + !! filtered [T ~> s] if positive, or as a fraction of DT if + !! negative [nondim]. This can never be taken to be longer than 2*dt. + !! Set this to 0 to apply no filtering. integer :: nstep_last = 0 !< The number of barotropic timesteps per baroclinic !! time step the last time btstep was called. real :: bebt !< A nondimensional number, from 0 to 1, that @@ -209,12 +209,12 @@ 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 [m]. + !! of the dynamic surface pressure for stability [Z ~> m]. 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 [m]. + !! a Laplacian were applied [L ~> m]. real :: const_dyn_psurf !< The constant that scales the dynamic surface - !! pressure, nondim. Stable values are < ~1.0. + !! pressure [nondim]. Stable values are < ~1.0. !! The default is 0.9. logical :: tides !< If true, apply tidal momentum forcing. real :: G_extra !< A nondimensional factor by which gtot is enhanced. @@ -239,9 +239,9 @@ module MOM_barotropic logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: debug_bt !< If true, write verbose checksums for debugging purposes. real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [m s-1]. + !! are set to 0 [L T-1 ~> m s-1]. real :: maxvel !< Velocity components greater than maxvel are - !! truncated to maxvel [m s-1]. + !! truncated to maxvel [L T-1 ~> m s-1]. real :: CFL_trunc !< If clip_velocity is true, velocity components will !! be truncated when they are large enough that the !! corresponding CFL number exceeds this value, nondim. @@ -312,40 +312,40 @@ module MOM_barotropic !> A desciption of the functional dependence of transport at a u-point type, private :: local_BT_cont_u_type real :: FA_u_EE !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east [H m ~> m2 or kg m-1]. + !! drawing from locations far to the east [H L ~> m2 or kg m-1]. real :: FA_u_E0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east [H m ~> m2 or kg m-1]. + !! drawing from nearby to the east [H L ~> m2 or kg m-1]. real :: FA_u_W0 !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west [H m ~> m2 or kg m-1]. + !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real :: FA_u_WW !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west [H m ~> m2 or kg m-1]. - real :: uBT_WW !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal + !! drawing from locations far to the west [H L ~> m2 or kg m-1]. + real :: uBT_WW !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. - real :: uBT_EE !< uBT_EE is a barotropic velocity [m s-1], beyond which the marginal + real :: uBT_EE !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. - real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: uh_WW !< The zonal transport when ubt=ubt_WW [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: uh_EE !< The zonal transport when ubt=ubt_EE [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uh_crvW !< The curvature of face area with velocity for flow from the west [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: uh_crvE !< The curvature of face area with velocity for flow from the east [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: uh_WW !< The zonal transport when ubt=ubt_WW [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: uh_EE !< The zonal transport when ubt=ubt_EE [H L2 T-1 ~> m3 s-1 or kg s-1]. end type local_BT_cont_u_type !> A desciption of the functional dependence of transport at a v-point type, private :: local_BT_cont_v_type real :: FA_v_NN !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north [H m ~> m2 or kg m-1]. + !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real :: FA_v_N0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north [H m ~> m2 or kg m-1]. + !! drawing from nearby to the north [H L ~> m2 or kg m-1]. real :: FA_v_S0 !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south [H m ~> m2 or kg m-1]. + !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real :: FA_v_SS !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south [H m ~> m2 or kg m-1]. - real :: vBT_SS !< vBT_SS is the barotropic velocity [m s-1], beyond which the marginal + !! drawing from locations far to the south [H L ~> m2 or kg m-1]. + real :: vBT_SS !< vBT_SS is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. - real :: vBT_NN !< vBT_NN is the barotropic velocity [m s-1], beyond which the marginal + real :: vBT_NN !< vBT_NN is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. - real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: vh_crvn !< The curvature of face area with velocity for flow from the north [H s2 m-1 ~> s2 or kg s2 m-3]. - real :: vh_SS !< The meridional transport when vbt=vbt_SS [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: vh_NN !< The meridional transport when vbt=vbt_NN [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vh_crvS !< The curvature of face area with velocity for flow from the south [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: vh_crvN !< The curvature of face area with velocity for flow from the north [H T2 L-1 ~> s2 or kg s2 m-3]. + real :: vh_SS !< The meridional transport when vbt=vbt_SS [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vh_NN !< The meridional transport when vbt=vbt_NN [H L2 T-1 ~> m3 s-1 or kg s-1]. end type local_BT_cont_v_type !> A container for passing around active tracer point memory limits @@ -384,45 +384,47 @@ 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, etaav, OBC, & - BT_cont, eta_PF_start, & + visc_rem_u, visc_rem_v, etaav, OBC, BT_cont, eta_PF_start, & taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in !< The initial (3-D) zonal + !! velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in !< The initial (3-D) meridional + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in !< The initial barotropic free surface height !! anomaly or column mass anomaly [H ~> m or kg m-2]. real, intent(in) :: dt !< The time increment to integrate over. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u !< The zonal baroclinic accelerations [m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v !< The meridional baroclinic accelerations, - !! [m s-2]. + !! [L T-2 ~> m s-2]. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies - !! [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + !! [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly or !! column mass anomaly) that was used to calculate the input !! pressure gradient accelerations (or its final value if !! eta_PF_start is provided [H ~> m or kg m-2]. !! Note: eta_in, pbce, and eta_PF_in must have up-to-date !! values in the first point of their halos. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal-velocities used to - !! calculate the Coriolis terms in bc_accel_u [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< Ditto for meridonal bc_accel_v. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor !< The (3-D) zonal velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor !< The (3-D) meridional velocities used to + !! calculate the Coriolis terms in bc_accel_u [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u !< The zonal acceleration of each layer due - !! to the barotropic calculation [m s-2]. + !! to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v !< The meridional acceleration of each layer - !! due to the barotropic calculation [m s-2]. + !! due to the barotropic calculation [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_out !< The final barotropic free surface !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav !< the barotropic zonal volume or mass !! fluxes averaged through the barotropic steps - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav !< the barotropic meridional volume or mass !! fluxes averaged through the barotropic steps - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 or kg s-1]. type(barotropic_CS), pointer :: CS !< The control structure returned by a !! previous call to barotropic_init. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: visc_rem_u !< Both the fraction of the momentum @@ -442,20 +444,22 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !! gradient at the start of the barotropic stepping !! [H ~> m or kg m-2]. real, dimension(:,:), optional, pointer :: taux_bot !< The zonal bottom frictional stress from - !! ocean to the seafloor [Pa]. + !! ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:), optional, pointer :: tauy_bot !< The meridional bottom frictional stress - !! from ocean to the seafloor [Pa]. + !! from ocean to the seafloor [kg L Z T-2 m-3 ~> Pa]. real, dimension(:,:,:), optional, pointer :: uh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate uh0 [m s-1] + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(:,:,:), optional, pointer :: u_uh0 !< The velocities used to calculate + !! uh0 [L T-1 ~> m s-1] real, dimension(:,:,:), optional, pointer :: vh0 !< The zonal layer transports at reference - !! velocities [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate vh0 [m s-1] + !! velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(:,:,:), optional, pointer :: v_vh0 !< The velocities used to calculate + !! vh0 [L T-1 ~> m s-1] ! Local variables real :: ubt_Cor(SZIB_(G),SZJ_(G)) ! The barotropic velocities that had been real :: vbt_Cor(SZI_(G),SZJB_(G)) ! used to calculate the input Coriolis - ! terms [m s-1]. + ! terms [L T-1 ~> m s-1]. real :: wt_u(SZIB_(G),SZJ_(G),SZK_(G)) ! wt_u and wt_v are the real :: wt_v(SZI_(G),SZJB_(G),SZK_(G)) ! normalized weights to ! be used in calculating barotropic velocities, possibly with @@ -472,71 +476,71 @@ 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 [s-1 Z-1 ~> s-1 m-1]. + real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1]. real, dimension(SZIBW_(CS),SZJW_(CS)) :: & - ubt, & ! The zonal barotropic velocity [m s-1]. + ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains ! after a time step, the remainder being lost to bottom drag. ! bt_rem_u is a nondimensional number between 0 and 1. BT_force_u, & ! The vertical average of all of the u-accelerations that are - ! not explicitly included in the barotropic equation [m s-2]. + ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. u_accel_bt, & ! The difference between the zonal acceleration from the - ! barotropic calculation and BT_force_u [m s-2]. - uhbt, & ! The zonal barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! barotropic calculation and BT_force_u [L T-2 ~> m s-2]. + uhbt, & ! The zonal barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. uhbt0, & ! The difference between the sum of the layer zonal thickness ! fluxes and the barotropic thickness flux using the same - ! velocity [H m2 s-1 ~> m3 s-1 or kg s-1]. - ubt_old, & ! The starting value of ubt in a barotropic step [m s-1]. - ubt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1]. - ubt_sum, & ! The sum of ubt over the time steps [m s-1]. - uhbt_sum, & ! The sum of uhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. - ubt_wtd, & ! A weighted sum used to find the filtered final ubt [m s-1]. - ubt_trans, & ! The latest value of ubt used for a transport [m s-1]. + ! velocity [H L2 T-1 ~> m3 s-1 or kg s-1]. + ubt_old, & ! The starting value of ubt in a barotropic step [L T-1 ~> m s-1]. + ubt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1]. + ubt_sum, & ! The sum of ubt over the time steps [L T-1 ~> m s-1]. + uhbt_sum, & ! The sum of uhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1]. + ubt_wtd, & ! A weighted sum used to find the filtered final ubt [L T-1 ~> m s-1]. + ubt_trans, & ! The latest value of ubt used for a transport [L T-1 ~> m s-1]. azon, bzon, & ! _zon & _mer are the values of the Coriolis force which czon, dzon, & ! are applied to the neighboring values of vbtav & ubtav, amer, bmer, & ! respectively to get the barotropic inertial rotation - cmer, dmer, & ! [s-1]. - Cor_u, & ! The zonal Coriolis acceleration [m s-2]. + cmer, dmer, & ! [T-1 ~> s-1]. + Cor_u, & ! The zonal Coriolis acceleration [L T-2 ~> m s-2]. Cor_ref_u, & ! The zonal barotropic Coriolis acceleration due - ! to the reference velocities [m s-2]. - PFu, & ! The zonal pressure force acceleration [m s-2]. - Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [s-1]. - PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [m s-2]. - Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [m s-2]. + ! to the reference velocities [L T-2 ~> m s-2]. + PFu, & ! The zonal pressure force acceleration [L T-2 ~> m s-2]. + 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, & ! A simply averaged depth at u points [Z ~> m]. Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & - vbt, & ! The meridional barotropic velocity [m s-1]. + vbt, & ! The meridional barotropic velocity [L T-1 ~> m s-1]. bt_rem_v, & ! The fraction of the barotropic meridional velocity that ! remains after a time step, the rest being lost to bottom ! drag. bt_rem_v is a nondimensional number between 0 and 1. BT_force_v, & ! The vertical average of all of the v-accelerations that are - ! not explicitly included in the barotropic equation [m s-2]. + ! not explicitly included in the barotropic equation [L T-2 ~> m s-2]. v_accel_bt, & ! The difference between the meridional acceleration from the - ! barotropic calculation and BT_force_v [m s-2]. - vhbt, & ! The meridional barotropic thickness fluxes [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! barotropic calculation and BT_force_v [L T-2 ~> m s-2]. + vhbt, & ! The meridional barotropic thickness fluxes [H L2 T-1 ~> m3 s-1 or kg s-1]. vhbt0, & ! The difference between the sum of the layer meridional ! thickness fluxes and the barotropic thickness flux using - ! the same velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - vbt_old, & ! The starting value of vbt in a barotropic step [m s-1]. - vbt_first, & ! The starting value of ubt in a series of barotropic steps [m s-1]. - vbt_sum, & ! The sum of vbt over the time steps [m s-1]. - vhbt_sum, & ! The sum of vhbt over the time steps [H m2 s-1 ~> m3 s-1 or kg s-1]. - vbt_wtd, & ! A weighted sum used to find the filtered final vbt [m s-1]. - vbt_trans, & ! The latest value of vbt used for a transport [m s-1]. - Cor_v, & ! The meridional Coriolis acceleration [m s-2]. + ! the same velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + vbt_old, & ! The starting value of vbt in a barotropic step [L T-1 ~> m s-1]. + vbt_first, & ! The starting value of ubt in a series of barotropic steps [L T-1 ~> m s-1]. + vbt_sum, & ! The sum of vbt over the time steps [L T-1 ~> m s-1]. + vhbt_sum, & ! The sum of vhbt over the time steps [H L2 T-1 ~> m3 s-1 or kg s-1]. + vbt_wtd, & ! A weighted sum used to find the filtered final vbt [L T-1 ~> m s-1]. + vbt_trans, & ! The latest value of vbt used for a transport [L T-1 ~> m s-1]. + Cor_v, & ! The meridional Coriolis acceleration [L T-2 ~> m s-2]. Cor_ref_v, & ! The meridional barotropic Coriolis acceleration due - ! to the reference velocities [m s-2]. - PFv, & ! The meridional pressure force acceleration [m s-2]. - Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [s-1]. + ! to the reference velocities [L T-2 ~> m s-2]. + PFv, & ! The meridional pressure force acceleration [L T-2 ~> m s-2]. + Rayleigh_v, & ! A Rayleigh drag timescale operating at v-points [T-1 ~> s-1]. PFv_bt_sum, & ! The summed meridional barotropic pressure gradient force, - ! [m s-2]. + ! [L T-2 ~> m s-2]. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, - ! [m s-2]. + ! [L T-2 ~> m s-2]. DCor_v, & ! A simply averaged depth at v points [Z ~> m]. Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & eta, & ! The barotropic free surface height anomaly or column mass ! anomaly [H ~> m or kg m-2] @@ -558,13 +562,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum gtot_S, & ! equations half a grid-point in the X-direction (X is N, S, E, or W) - ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! 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]. dyn_coef_eta, & ! The coefficient relating the changes in eta to the ! dynamic surface pressure under rigid ice - ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - p_surf_dyn ! A dynamic surface pressure under rigid ice [m2 s-2]. + ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + p_surf_dyn ! A dynamic surface pressure under rigid ice [L2 T-2 ~> m2 s-2]. type(local_BT_cont_u_type), dimension(SZIBW_(CS),SZJW_(CS)) :: & BTCL_u ! A repackaged version of the u-point information in BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -576,15 +580,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, dimension(SZIW_(CS),SZJBW_(CS)) :: & vbt_prev, vhbt_prev, vbt_sum_prev, vhbt_sum_prev, vbt_wtd_prev ! for OBC - real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [m3 kg-1]. + real :: mass_to_Z ! The depth unit converison divided by the mean density (Rho0) [Z m2 kg-1 ~> m3 kg-1]. + real :: mass_accel_to_Z ! The depth unit converison times an acceleration conversion divided by + ! the mean density (Rho0) [Z L m s2 T-2 kg-1 ~> m3 kg-1]. real :: visc_rem ! A work variable that may equal visc_rem_[uv]. Nondim. - real :: vel_prev ! The previous velocity [m s-1]. - real :: dtbt ! The barotropic time step [s]. - real :: bebt ! A copy of CS%bebt. + real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. + real :: dtbt ! The barotropic time step [T ~> s]. + real :: dt_in_T ! The baroclinic time step [T ~> s]. + real :: bebt ! A copy of CS%bebt [nondim]. real :: be_proj ! The fractional amount by which velocities are projected ! when project_velocity is true. For now be_proj is set ! to equal bebt, as they have similar roles and meanings. - real :: Idt ! The inverse of dt [s-1]. + real :: Idt ! The inverse of dt [T-1 ~> s-1]. real :: det_de ! The partial derivative due to self-attraction and loading ! of the reference geopotential with the sea surface height. ! This is typically ~0.09 or less. @@ -607,24 +614,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, logical :: project_velocity, add_uh0 real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta - ! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real :: ice_strength = 0.0 ! The effective strength of the ice [m s-2]. + ! [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 :: Idt_max2 ! The squared inverse of the local maximum stable - ! barotropic time step [s-2]. + ! barotropic time step [T-2 ~> s-2]. real :: H_min_dyn ! The minimum depth to use in limiting the size of the ! dynamic surface pressure for stability [H ~> m or kg m-2]. real :: H_eff_dx2 ! The effective total thickness divided by the grid spacing - ! squared [H m-2 ~> m-1 or kg m-4]. - real :: vel_tmp ! A temporary velocity [m s-1]. - real :: u_max_cor, v_max_cor ! The maximum corrective velocities [m s-1]. + ! squared [H L-2 ~> m-1 or kg m-4]. + real :: u_max_cor, v_max_cor ! The maximum corrective velocities [L T-1 ~> m s-1]. real :: Htot ! The total thickness [H ~> m or kg m-2]. real :: eta_cor_max ! The maximum fluid that can be added as a correction to eta [H ~> m or kg m-2]. - real :: accel_underflow ! An acceleration that is so small it should be zeroed out. + real :: accel_underflow ! An acceleration that is so small it should be zeroed out [L T-2 ~> m s-2]. real, allocatable, dimension(:) :: wt_vel, wt_eta, wt_accel, wt_trans, wt_accel2 real :: sum_wt_vel, sum_wt_eta, sum_wt_accel, sum_wt_trans real :: I_sum_wt_vel, I_sum_wt_eta, I_sum_wt_accel, I_sum_wt_trans - real :: dt_filt ! The half-width of the barotropic filter [s]. + real :: dt_filt ! The half-width of the barotropic filter [T ~> s]. real :: trans_wt1, trans_wt2 ! weight used to compute ubt_trans and vbt_trans integer :: nfilter @@ -647,7 +653,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB MS%isdw = CS%isdw ; MS%iedw = CS%iedw ; MS%jsdw = CS%jsdw ; MS%jedw = CS%jedw - Idt = 1.0 / dt + dt_in_T = US%s_to_T*dt + Idt = 1.0 / dt_in_T accel_underflow = CS%vel_underflow * Idt use_BT_cont = .false. @@ -714,9 +721,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Set the actual barotropic time step. Instep = 1.0 / real(nstep) - dtbt = dt * Instep + dtbt = dt_in_T * Instep bebt = CS%bebt be_proj = CS%bebt + mass_accel_to_Z = US%m_to_L*US%T_to_s**2 * US%m_to_Z / GV%Rho0 mass_to_Z = US%m_to_Z / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans @@ -821,7 +829,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do I=is-1,ie - q(I,J) = 0.25 * US%s_to_T*G%CoriolisBu(I,J) * & + q(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) @@ -955,18 +963,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Calculate the open areas at the velocity points. ! The halo updates are needed before Datu is first used, either in set_up_BT_OBC or ubt_Cor. if (use_BT_cont) then - call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, CS%BT_Domain, 1+ievf-ie) + call set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, CS%BT_Domain, 1+ievf-ie) else if (CS%Nonlinear_continuity) then - call find_face_areas(Datu, Datv, G, GV, CS, MS, eta, 1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) endif endif ! 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, MS, ievf-ie, use_BT_cont, & + call set_up_BT_OBC(OBC, eta, CS%BT_OBC, CS%BT_Domain, G, GV, US, MS, ievf-ie, use_BT_cont, & Datu, Datv, BTCL_u, BTCL_v) endif @@ -981,14 +989,14 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! ### IDatu here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatu should be replaced by ! ### CS%dy_Cu(I,j) / (d(uhbt)/du) (with appropriate bounds). - 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) * mass_accel_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ! ### IDatv here should be replaced with 1/D+eta(Bous) or 1/eta(non-Bous). ! ### although with BT_cont_types IDatv should be replaced by ! ### CS%dx_Cv(I,j) / (d(vhbt)/dv) (with appropriate bounds). - 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) * mass_accel_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) enddo ; enddo if (present(taux_bot) .and. present(tauy_bot)) then if (associated(taux_bot) .and. associated(tauy_bot)) then @@ -1058,15 +1066,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (id_clock_calc_pre > 0) call cpu_clock_begin(id_clock_calc_pre) call adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, MS, 1+ievf-ie) + G, US, MS, 1+ievf-ie) endif !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j),BTCL_u(I,j)) + uhbt0(I,j) = uhbt(I,j) - find_uhbt(ubt(I,j), BTCL_u(I,j), US) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J),BTCL_v(i,J)) + vhbt0(i,J) = vhbt(i,J) - find_vhbt(vbt(i,J), BTCL_v(i,J), US) enddo ; enddo else !$OMP parallel do default(shared) @@ -1352,11 +1360,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! CFL_cor. u_max_cor = G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) v_max_cor = G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) - eta_cor_max = dt * (CS%IareaT(i,j) * & - (((find_uhbt(u_max_cor,BTCL_u(I,j)) + uhbt0(I,j)) - & - (find_uhbt(-u_max_cor,BTCL_u(I-1,j)) + uhbt0(I-1,j))) + & - ((find_vhbt(v_max_cor,BTCL_v(i,J)) + vhbt0(i,J)) - & - (find_vhbt(-v_max_cor,BTCL_v(i,J-1)) + vhbt0(i,J-1))) )) + eta_cor_max = dt_in_T * (CS%IareaT(i,j) * & + (((find_uhbt(u_max_cor, BTCL_u(I,j), US) + uhbt0(I,j)) - & + (find_uhbt(-u_max_cor, BTCL_u(I-1,j), US) + uhbt0(I-1,j))) + & + ((find_vhbt(v_max_cor, BTCL_v(i,J), US) + vhbt0(i,J)) - & + (find_vhbt(-v_max_cor, BTCL_v(i,J-1), US) + vhbt0(i,J-1))) )) CS%eta_cor(i,j) = min(CS%eta_cor(i,j), max(0.0, eta_cor_max)) else ! Limit the sink (inward) correction to the amount of mass that is already @@ -1368,8 +1376,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif endif ; enddo ; enddo else ; do j=js,je ; do i=is,ie - if (abs(CS%eta_cor(i,j)) > dt*CS%eta_cor_bound(i,j)) & - CS%eta_cor(i,j) = sign(dt*CS%eta_cor_bound(i,j),CS%eta_cor(i,j)) + if (abs(CS%eta_cor(i,j)) > dt_in_T*CS%eta_cor_bound(i,j)) & + CS%eta_cor(i,j) = sign(dt_in_T*CS%eta_cor_bound(i,j), CS%eta_cor(i,j)) enddo ; enddo ; endif ; endif !$OMP do do j=js,je ; do i=is,ie @@ -1380,9 +1388,9 @@ 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%m_to_H * CS%Dmin_dyn_psurf + H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf if (ice_is_rigid .and. use_BT_cont) & - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) if (ice_is_rigid) then !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength) do j=js,je ; do i=is,ie @@ -1396,22 +1404,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, gtot_W(i,j) * (Datu(I-1,j)*G%IdxCu(I-1,j))) + & (gtot_N(i,j) * (Datv(i,J)*G%IdyCv(i,J)) + & gtot_S(i,j) * (Datv(i,J-1)*G%IdyCv(i,J-1)))) + & - US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) - H_eff_dx2 = max(H_min_dyn * (G%IdxT(i,j)**2 + G%IdyT(i,j)**2), & + ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + H_eff_dx2 = max(H_min_dyn * ((G%IdxT(i,j))**2 + (G%IdyT(i,j))**2), & G%IareaT(i,j) * & ((Datu(I,j)*G%IdxCu(I,j) + Datu(I-1,j)*G%IdxCu(I-1,j)) + & (Datv(i,J)*G%IdyCv(i,J) + Datv(i,J-1)*G%IdyCv(i,J-1)) ) ) dyn_coef_max = CS%const_dyn_psurf * max(0.0, 1.0 - dtbt**2 * Idt_max2) / & (dtbt**2 * H_eff_dx2) - ! ice_strength has units of [m s-2]. rigidity_ice_[uv] has units of [m3 s-1]. - ice_strength = ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + & + ! ice_strength has units of [L2 Z-1 T-2 ~> m s-2]. rigidity_ice_[uv] has units of [m3 s-1]. + ice_strength = US%m_to_L**4*US%Z_to_m*US%T_to_s* & + ((forces%rigidity_ice_u(I,j) + forces%rigidity_ice_u(I-1,j)) + & (forces%rigidity_ice_v(i,J) + forces%rigidity_ice_v(i,J-1))) / & (CS%ice_strength_length**2 * dtbt) - ! Units of dyn_coef: [m2 s-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_m) + ! 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) enddo ; enddo ; endif endif @@ -1445,11 +1454,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%debug) then call uvchksum("BT [uv]hbt", uhbt, vhbt, CS%debug_BT_HI, haloshift=0, & - scale=GV%H_to_m) - call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0) + scale=US%s_to_T*US%L_to_m**2*GV%H_to_m) + call uvchksum("BT Initial [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=0, scale=US%L_T_to_m_s) call hchksum(eta, "BT Initial eta", CS%debug_BT_HI, haloshift=0, scale=GV%H_to_m) call uvchksum("BT BT_force_[uv]", BT_force_u, BT_force_v, & - CS%debug_BT_HI, haloshift=0) + CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2) if (interp_eta_PF) then call hchksum(eta_PF_1, "BT eta_PF_1",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) call hchksum(d_eta_PF, "BT d_eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) @@ -1457,20 +1466,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, call hchksum(eta_PF, "BT eta_PF",CS%debug_BT_HI,haloshift=0, scale=GV%H_to_m) call hchksum(eta_PF_in, "BT eta_PF_in",G%HI,haloshift=0, scale=GV%H_to_m) endif - call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0) - call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, & - haloshift=0, scale=GV%H_to_m) + call uvchksum("BT Cor_ref_[uv]", Cor_ref_u, Cor_ref_v, CS%debug_BT_HI, haloshift=0, scale=US%L_T2_to_m_s2) + call uvchksum("BT [uv]hbt0", uhbt0, vhbt0, CS%debug_BT_HI, haloshift=0, & + scale=US%L_to_m**2*US%s_to_T*GV%H_to_m) if (.not. use_BT_cont) then - call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, & - scale=GV%H_to_m) + call uvchksum("BT Dat[uv]", Datu, Datv, CS%debug_BT_HI, haloshift=1, scale=US%L_to_m*GV%H_to_m) endif call uvchksum("BT wt_[uv]", wt_u, wt_v, G%HI, 0, .true., .true.) call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, 0, .true., .true.) - call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, & - G%HI, haloshift=0) + 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) - call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, & - G%HI, haloshift=1) + call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=1) endif if (query_averaging_enabled(CS%diag)) then @@ -1485,9 +1491,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (project_velocity) then ; eta_PF_BT => eta ; else ; eta_PF_BT => eta_pred ; endif if (CS%dt_bt_filter >= 0.0) then - dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt)) + dt_filt = 0.5 * max(0.0, min(CS%dt_bt_filter, 2.0*dt_in_T)) else - dt_filt = 0.5 * max(0.0, dt * min(-CS%dt_bt_filter, 2.0)) + dt_filt = 0.5 * max(0.0, dt_in_T * min(-CS%dt_bt_filter, 2.0)) endif nfilter = ceiling(dt_filt / dtbt) @@ -1545,21 +1551,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%clip_velocity) then do j=jsv,jev ; do I=isv-1,iev - if ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + if ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) - elseif ((ubt(I,j) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + ubt(I,j) = (-0.95*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) + elseif ((ubt(I,j) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + ubt(I,j) = (0.95*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) endif enddo ; enddo do J=jsv-1,jev ; do i=isv,iev - if ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + if ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) - elseif ((vbt(i,J) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + vbt(i,J) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) + elseif ((vbt(i,J) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then ! Add some error reporting later. - vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + vbt(i,J) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) endif enddo ; enddo endif @@ -1577,33 +1583,27 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if ((.not.use_BT_cont) .and. CS%Nonlinear_continuity .and. & (CS%Nonlin_cont_update_period > 0)) then if ((n>1) .and. (mod(n-1,CS%Nonlin_cont_update_period) == 0)) & - call find_face_areas(Datu, Datv, G, GV, CS, MS, eta, 1+iev-ie) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, 1+iev-ie) endif -!GOMP parallel default(none) shared(CS,isv,iev,jsv,jev,project_velocity,use_BT_cont, & -!GOMP uhbt,vhbt,ubt,BTCL_u,uhbt0,vbt,BTCL_v,vhbt0, & -!GOMP eta_pred,eta,eta_src,dtbt,Datu,Datv,p_surf_dyn, & -!GOMP dyn_coef_eta,find_etaav,is,ie,js,je,eta_sum, & -!GOMP wt_accel2,n,eta_PF_BT,interp_eta_PF,wt_end, & -!GOMP Instep,eta_PF,eta_PF_1,d_eta_PF, & -!GOMP apply_OBC_flather,ubt_old,vbt_old ) + !GOMP parallel default(shared) if (CS%dynamic_psurf .or. .not.project_velocity) then if (use_BT_cont) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-2,iev+1 - uhbt(I,j) = find_uhbt(ubt(I,j),BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(ubt(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=jsv-2,jev+1 ; do i=isv-1,iev+1 - vhbt(i,J) = find_vhbt(vbt(i,J),BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vbt(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) enddo ; enddo else -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_pred(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & (((Datu(I-1,j)*ubt(I-1,j) + uhbt0(I-1,j)) - & @@ -1614,7 +1614,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 p_surf_dyn(i,j) = dyn_coef_eta(i,j) * (eta_pred(i,j) - eta(i,j)) enddo ; enddo @@ -1625,7 +1625,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! eta_PF_BT => eta_pred ; if (project_velocity) eta_PF_BT => eta if (find_etaav) then -!GOMP do + !GOMP do do j=js,je ; do i=is,ie eta_sum(i,j) = eta_sum(i,j) + wt_accel2(n) * eta_PF_BT(i,j) enddo ; enddo @@ -1633,23 +1633,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (interp_eta_PF) then wt_end = n*Instep ! This could be (n-0.5)*Instep. -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do i=isv-1,iev+1 eta_PF(i,j) = eta_PF_1(i,j) + wt_end*d_eta_PF(i,j) enddo ; enddo endif if (apply_OBC_flather .or. apply_OBC_open) then -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-2,iev+1 ubt_old(I,j) = ubt(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=jsv-2,jev+1 ; do i=isv,iev vbt_old(i,J) = vbt(i,J) enddo ; enddo endif -!GOMP end parallel + !GOMP end parallel if (apply_OBCs) then if (MOD(n+G%first_direction,2)==1) then @@ -1659,30 +1659,26 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%BT_OBC%apply_u_OBCs) then ! save the old value of ubt and uhbt -!GOMP parallel do default(none) shared(isv,iev,jsv,jev,ioff,joff,ubt_prev,ubt,uhbt_prev, & -!GOMP uhbt,ubt_sum_prev,ubt_sum,uhbt_sum_prev, & -!GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd) + !GOMP parallel do default(shared) do J=jsv-joff,jev+joff ; do i=isv-1,iev - ubt_prev(i,J) = ubt(i,J); uhbt_prev(i,J) = uhbt(i,J) - ubt_sum_prev(i,J)=ubt_sum(i,J); uhbt_sum_prev(i,J)=uhbt_sum(i,J) ; ubt_wtd_prev(i,J)=ubt_wtd(i,J) + ubt_prev(i,J) = ubt(i,J) ; uhbt_prev(i,J) = uhbt(i,J) + ubt_sum_prev(i,J) = ubt_sum(i,J) ; uhbt_sum_prev(i,J) = uhbt_sum(i,J) ; ubt_wtd_prev(i,J) = ubt_wtd(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! save the old value of vbt and vhbt -!GOMP parallel do default(none) shared(isv,iev,jsv,jev,ioff,joff,vbt_prev,vbt,vhbt_prev, & -!GOMP vhbt,vbt_sum_prev,vbt_sum,vhbt_sum_prev, & -!GOMP vhbt_sum,vbt_wtd_prev,vbt_wtd) + !GOMP parallel do default(shared) do J=jsv-1,jev ; do i=isv-ioff,iev+ioff - vbt_prev(i,J) = vbt(i,J); vhbt_prev(i,J) = vhbt(i,J) - vbt_sum_prev(i,J)=vbt_sum(i,J); vhbt_sum_prev(i,J)=vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J) + vbt_prev(i,J) = vbt(i,J) ; vhbt_prev(i,J) = vhbt(i,J) + vbt_sum_prev(i,J) = vbt_sum(i,J) ; vhbt_sum_prev(i,J) = vhbt_sum(i,J) ; vbt_wtd_prev(i,J) = vbt_wtd(i,J) enddo ; enddo endif endif -!GOMP parallel default(shared) private(vel_prev) + !GOMP parallel default(shared) private(vel_prev) if (MOD(n+G%first_direction,2)==1) then ! On odd-steps, update v first. -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1691,19 +1687,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dgeo_de * CS%IdyCv(i,J) enddo ; enddo if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1719,24 +1715,24 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 - vhbt(i,J) = find_vhbt(vbt_trans(i,J),BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then - vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J) + vbt(i,J) = vbt_prev(i,J) ; vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif ! Now update the zonal velocity. -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1747,19 +1743,19 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & @@ -1776,25 +1772,25 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev - uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo endif else ! On even steps, update u first. -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev Cor_u(I,j) = ((azon(I,j) * vbt(i+1,J) + czon(I,j) * vbt(i,J-1)) + & (bzon(I,j) * vbt(i,J) + dzon(I,j) * vbt(i+1,J-1))) - & @@ -1805,26 +1801,27 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev PFu(I,j) = PFu(I,j) + (p_surf_dyn(i,j) - p_surf_dyn(i+1,j)) * CS%IdxCu(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! zero out pressure force across boundary -!GOMP do + !GOMP do do j=jsv,jev ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then PFu(I,j) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev vel_prev = ubt(I,j) ubt(I,j) = bt_rem_u(I,j) * (ubt(I,j) + & dtbt * ((BT_force_u(I,j) + Cor_u(I,j)) + PFu(I,j))) if (abs(ubt(I,j)) < CS%vel_underflow) ubt(I,j) = 0.0 ubt_trans(I,j) = trans_wt1*ubt(I,j) + trans_wt2*vel_prev + if (CS%linear_wave_drag) then u_accel_bt(I,j) = u_accel_bt(I,j) + wt_accel(n) * & ((Cor_u(I,j) + PFu(I,j)) - ubt(I,j)*Rayleigh_u(I,j)) @@ -1834,18 +1831,18 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev - uhbt(I,j) = find_uhbt(ubt_trans(I,j),BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(ubt_trans(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo else -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev uhbt(I,j) = Datu(I,j)*ubt_trans(I,j) + uhbt0(I,j) enddo ; enddo endif if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. -!GOMP do + !GOMP do do j=jsv-1,jev+1 ; do I=isv-1,iev ; if (OBC%segnum_u(I,j) /= OBC_NONE) then ubt(I,j) = ubt_prev(I,j); uhbt(I,j) = uhbt_prev(I,j) endif ; enddo ; enddo @@ -1853,7 +1850,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! Now update the meridional velocity. if (CS%use_old_coriolis_bracket_bug) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + bmer(I,j) * ubt(I,j)) + & (cmer(I,j+1) * ubt(I,j+1) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1862,7 +1859,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, dgeo_de * CS%IdyCv(i,J) enddo ; enddo else -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev Cor_v(i,J) = -1.0*((amer(I-1,j) * ubt(I-1,j) + cmer(I,j+1) * ubt(I,j+1)) + & (bmer(I,j) * ubt(I,j) + dmer(I-1,j+1) * ubt(I-1,j+1))) - Cor_ref_v(i,J) @@ -1873,20 +1870,20 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%dynamic_psurf) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev PFv(i,J) = PFv(i,J) + (p_surf_dyn(i,j) - p_surf_dyn(i,j+1)) * CS%IdyCv(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! zero out PF across boundary -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv-1,iev+1 ; if (OBC%segnum_v(i,J) /= OBC_NONE) then PFv(i,J) = 0.0 endif ; enddo ; enddo endif -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev vel_prev = vbt(i,J) vbt(i,J) = bt_rem_v(i,J) * (vbt(i,J) + & @@ -1902,90 +1899,85 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif enddo ; enddo if (use_BT_cont) then -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev - vhbt(i,J) = find_vhbt(vbt_trans(i,J),BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vbt_trans(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev vhbt(i,J) = Datv(i,J)*vbt_trans(i,J) + vhbt0(i,J) enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. -!GOMP do + !GOMP do do J=jsv-1,jev ; do i=isv,iev ; if (OBC%segnum_v(i,J) /= OBC_NONE) then vbt(i,J) = vbt_prev(i,J); vhbt(i,J) = vhbt_prev(i,J) endif ; enddo ; enddo endif endif -!GOMP end parallel - -!GOMP parallel default(none) shared(is,ie,js,je,find_PF,PFu_bt_sum,wt_accel2, & -!GOMP PFu,PFv_bt_sum,PFv,find_Cor,Coru_bt_sum, & -!GOMP Cor_u,Corv_bt_sum,Cor_v,ubt_sum,wt_trans, & -!GOMP ubt_trans,uhbt_sum,uhbt,ubt_wtd,wt_vel, & -!GOMP ubt,vbt_sum,vbt_trans,vhbt_sum,vhbt, & -!GOMP vbt_wtd,vbt,n ) + !GOMP end parallel + + !GOMP parallel default(shared) if (find_PF) then -!GOMP do + !GOMP do do j=js,je ; do I=is-1,ie PFu_bt_sum(I,j) = PFu_bt_sum(I,j) + wt_accel2(n) * PFu(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=js-1,je ; do i=is,ie PFv_bt_sum(i,J) = PFv_bt_sum(i,J) + wt_accel2(n) * PFv(i,J) enddo ; enddo endif if (find_Cor) then -!GOMP do + !GOMP do do j=js,je ; do I=is-1,ie Coru_bt_sum(I,j) = Coru_bt_sum(I,j) + wt_accel2(n) * Cor_u(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=js-1,je ; do i=is,ie Corv_bt_sum(i,J) = Corv_bt_sum(i,J) + wt_accel2(n) * Cor_v(i,J) enddo ; enddo endif -!GOMP do + !GOMP do do j=js,je ; do I=is-1,ie ubt_sum(I,j) = ubt_sum(I,j) + wt_trans(n) * ubt_trans(I,j) uhbt_sum(I,j) = uhbt_sum(I,j) + wt_trans(n) * uhbt(I,j) ubt_wtd(I,j) = ubt_wtd(I,j) + wt_vel(n) * ubt(I,j) enddo ; enddo -!GOMP do + !GOMP do do J=js-1,je ; do i=is,ie vbt_sum(i,J) = vbt_sum(i,J) + wt_trans(n) * vbt_trans(i,J) vhbt_sum(i,J) = vhbt_sum(i,J) + wt_trans(n) * vhbt(i,J) vbt_wtd(i,J) = vbt_wtd(i,J) + wt_vel(n) * vbt(i,J) enddo ; enddo -!GOMP end parallel + !GOMP end parallel if (apply_OBCs) then if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. -!GOMP parallel do default(none) shared(is,ie,js,je,ubt_sum_prev,ubt_sum,uhbt_sum_prev,& -!GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd) + !GOMP parallel do default(shared) do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then - ubt_sum(I,j)=ubt_sum_prev(I,j); uhbt_sum(I,j)=uhbt_sum_prev(I,j) ; ubt_wtd(I,j)=ubt_wtd_prev(I,j) + ubt_sum(I,j) = ubt_sum_prev(I,j) ; uhbt_sum(I,j) = uhbt_sum_prev(I,j) + ubt_wtd(I,j) = ubt_wtd_prev(I,j) endif enddo ; enddo endif if (CS%BT_OBC%apply_v_OBCs) then ! copy back the value for v-points on the boundary. -!GOMP parallel do default(none) shared(is,ie,js,je,vbt_sum_prev,vbt_sum,vhbt_sum_prev, & -!GOMP vhbt_sum,vbt_wtd_prev,vbt_wtd) + !GOMP parallel do default(shared) do J=js-1,je ; do I=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then - vbt_sum(i,J)=vbt_sum_prev(i,J); vhbt_sum(i,J)=vhbt_sum_prev(i,J) ; vbt_wtd(i,J)=vbt_wtd_prev(i,J) + vbt_sum(i,J) = vbt_sum_prev(i,J) ; vhbt_sum(i,J) = vhbt_sum_prev(i,J) + vbt_wtd(i,J) = vbt_wtd_prev(i,J) endif enddo ; enddo endif call apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, & ubt_trans, vbt_trans, eta, ubt_old, vbt_old, CS%BT_OBC, & - G, MS, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, & + G, MS, US, iev-ie, dtbt, bebt, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v, & uhbt0, vhbt0) if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then @@ -2004,11 +1996,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, endif if (CS%debug_bt) then - call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, & - CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m) + call uvchksum("BT [uv]hbt just after OBC", uhbt, vhbt, CS%debug_BT_HI, haloshift=iev-ie, & + scale=US%s_to_T*US%L_to_m**2*GV%H_to_m) endif -!$OMP parallel do default(none) shared(isv,iev,jsv,jev,n,eta,eta_src,dtbt,CS,uhbt,vhbt,eta_wtd,wt_eta) + !$OMP parallel do default(shared) do j=jsv,jev ; do i=isv,iev eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) @@ -2017,8 +2009,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo if (do_hifreq_output) then - time_step_end = time_bt_start + real_to_time(n*dtbt) - call enable_averaging(dtbt, time_step_end, CS%diag) + time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt) + call enable_averaging(US%T_to_s*dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) if (CS%id_eta_hifreq > 0) call post_data(CS%id_eta_hifreq, eta(isd:ied,jsd:jed), CS%diag) @@ -2029,9 +2021,9 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%debug_bt) then write(mesg,'("BT step ",I4)') n - call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, & - CS%debug_BT_HI, haloshift=iev-ie) - call hchksum(eta, trim(mesg)//" eta",CS%debug_BT_HI,haloshift=iev-ie, scale=GV%H_to_m) + call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=iev-ie, & + scale=US%L_T_to_m_s) + call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=iev-ie, scale=GV%H_to_m) endif enddo ! end of do n=1,ntimestep @@ -2120,7 +2112,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (G%nonblocking_updates) then call complete_group_pass(CS%pass_e_anom, G%Domain) if (find_etaav) call start_group_pass(CS%pass_etaav, G%Domain) - call start_group_pass(CS%pass_ubta_uhbta, G%Domain) + call start_group_pass(CS%pass_ubta_uhbta, G%DoMain) else call do_group_pass(CS%pass_ubta_uhbta, G%Domain) endif @@ -2131,15 +2123,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=is-1,ie - accel_layer_u(I,j,k) = u_accel_bt(I,j) - & + accel_layer_u(I,j,k) = (u_accel_bt(I,j) - & ((pbce(i+1,j,k) - gtot_W(i+1,j)) * e_anom(i+1,j) - & - (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) + (pbce(i,j,k) - gtot_E(i,j)) * e_anom(i,j)) * CS%IdxCu(I,j) ) if (abs(accel_layer_u(I,j,k)) < accel_underflow) accel_layer_u(I,j,k) = 0.0 enddo ; enddo do J=js-1,je ; do i=is,ie - accel_layer_v(i,J,k) = v_accel_bt(i,J) - & - ((pbce(i,j+1,k) - gtot_S(i,j+1))*e_anom(i,j+1) - & - (pbce(i,j,k) - gtot_N(i,j))*e_anom(i,j)) * CS%IdyCv(i,J) + accel_layer_v(i,J,k) = (v_accel_bt(i,J) - & + ((pbce(i,j+1,k) - gtot_S(i,j+1)) * e_anom(i,j+1) - & + (pbce(i,j,k) - gtot_N(i,j)) * e_anom(i,j)) * CS%IdyCv(i,J) ) if (abs(accel_layer_v(i,J,k)) < accel_underflow) accel_layer_v(i,J,k) = 0.0 enddo ; enddo enddo @@ -2149,13 +2141,13 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! symmetric-memory computational domain, not in the wide halo regions. if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then - u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt + u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt_in_T do k=1,nz ; accel_layer_u(I,j,k) = u_accel_bt(I,j) ; enddo endif enddo ; enddo ; endif if (CS%BT_OBC%apply_v_OBCs) then ; do J=js-1,je ; do i=is,ie if (OBC%segnum_v(i,J) /= OBC_NONE) then - v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt + v_accel_bt(i,J) = (vbt_wtd(i,J) - vbt_first(i,J)) / dt_in_T do k=1,nz ; accel_layer_v(i,J,k) = v_accel_bt(i,J) ; enddo endif enddo ; enddo ; endif @@ -2170,10 +2162,10 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vbt_wtd(i,J) ; enddo ; enddo if (use_BT_cont) then do j=js,je ; do I=is-1,ie - CS%uhbt_IC(I,j) = find_uhbt(ubt_wtd(I,j), BTCL_u(I,j)) + uhbt0(I,j) + CS%uhbt_IC(I,j) = find_uhbt(ubt_wtd(I,j), BTCL_u(I,j), US) + uhbt0(I,j) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%vhbt_IC(i,J) = find_vhbt(vbt_wtd(i,J), BTCL_v(i,J)) + vhbt0(i,J) + CS%vhbt_IC(i,J) = find_vhbt(vbt_wtd(i,J), BTCL_v(i,J), US) + vhbt0(i,J) enddo ; enddo else do j=js,je ; do I=is-1,ie @@ -2274,12 +2266,12 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! height anomaly or column mass anomaly [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce !< The baroclinic pressure !! anomaly in each layer due to free surface - !! height anomalies [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + !! height anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a !! function of barotropic flow. real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational - !! acceleration [m2 Z-1 s-2 ~> m s-2]. + !! acceleration [L2 Z-1 T-2 ~> m 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]. @@ -2290,24 +2282,28 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) gtot_W, & ! free surface height deviations to pressure forces (including gtot_N, & ! GFS and baroclinic contributions) in the barotropic momentum gtot_S ! equations half a grid-point in the X-direction (X is N, S, E, or W) - ! from the thickness point [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! 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.) real, dimension(SZIBS_(G),SZJ_(G)) :: & Datu ! Basin depth at u-velocity grid points times the y-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJBS_(G)) :: & Datv ! Basin depth at v-velocity grid points times the x-grid - ! spacing [H m ~> m2 or kg m-1]. + ! spacing [H L ~> m2 or kg m-1]. real :: det_de ! The partial derivative due to self-attraction and loading - ! of the reference geopotential with the sea surface height. + ! of the reference geopotential with the sea surface height [nondim]. ! This is typically ~0.09 or less. real :: dgeo_de ! The constant of proportionality between geopotential and - ! sea surface height. It is a nondimensional number of + ! sea surface height [nondim]. It is a nondimensional number of ! order 1. For stability, this may be made larger ! than physical problem would suggest. real :: add_SSH ! An additional contribution to SSH to provide a margin of error ! when calculating the external wave speed [Z ~> m]. - real :: min_max_dt2, Idt_max2, dtbt_max + real :: min_max_dt2 ! The square of the minimum value of the largest stable barotropic + ! timesteps [T2 ~> s2] + real :: dtbt_max ! The maximum barotropic timestep [T ~> s] + real :: Idt_max2 ! The squared inverse of the local maximum stable + ! barotropic time step [T-2 ~> s-2]. logical :: use_BT_cont type(memory_size_type) :: MS @@ -2329,11 +2325,11 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) if (present(BT_cont)) use_BT_cont = (associated(BT_cont)) if (use_BT_cont) then - call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, 0, .true.) + call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, 0, .true.) elseif (CS%Nonlinear_continuity .and. present(eta)) then - call find_face_areas(Datu, Datv, G, GV, CS, MS, eta=eta, halo=0) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta=eta, halo=0) else - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=0, add_max=add_SSH) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=0, add_max=add_SSH) endif det_de = 0.0 @@ -2357,15 +2353,15 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) enddo ; enddo endif - min_max_dt2 = 1.0e38 ! A huge number. + min_max_dt2 = 1.0e38*US%s_to_T**2 ! A huge value for the permissible timestep squared. do j=js,je ; do i=is,ie ! This is pretty accurate for gravity waves, but it is a conservative ! estimate since it ignores the stabilizing effect of the bottom drag. Idt_max2 = 0.5 * (1.0 + 2.0*CS%bebt) * (G%IareaT(i,j) * & ((gtot_E(i,j)*Datu(I,j)*G%IdxCu(I,j) + gtot_W(i,j)*Datu(I-1,j)*G%IdxCu(I-1,j)) + & (gtot_N(i,j)*Datv(i,J)*G%IdyCv(i,J) + gtot_S(i,j)*Datv(i,J-1)*G%IdyCv(i,J-1))) + & - US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2))) + ((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 (Idt_max2 * min_max_dt2 > 1.0) min_max_dt2 = 1.0 / Idt_max2 enddo ; enddo dtbt_max = sqrt(min_max_dt2 / dgeo_de) @@ -2373,8 +2369,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) call min_across_PEs(dtbt_max) if (id_clock_sync > 0) call cpu_clock_end(id_clock_sync) - CS%dtbt = CS%dtbt_fraction * dtbt_max - CS%dtbt_max = dtbt_max + CS%dtbt = CS%dtbt_fraction * US%T_to_s * dtbt_max + CS%dtbt_max = US%T_to_s * dtbt_max end subroutine set_dtbt !> The following 4 subroutines apply the open boundary conditions. @@ -2382,41 +2378,43 @@ end subroutine set_dtbt !! 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, halo, dtbt, bebt, use_BT_cont, Datu, Datv, & + G, MS, US, halo, dtbt, bebt, use_BT_cont, Datu, Datv, & BTCL_u, BTCL_v, uhbt0, vhbt0) 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(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 [m s-1]. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< the zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< the zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< the zonal barotropic velocity used in - !! transport [m s-1]. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< the meridional barotropic velocity [m s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity used in + !! transport [L T-1 ~> m s-1]. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic velocity + !! [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< the meridional barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< the meridional BT velocity used in - !! transports [m s-1]. + !! 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(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic - !! step [m s-1]. + !! 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 - !! step [m s-1]. + !! step [L T-1 ~> m s-1]. 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(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: halo !< The extra halo size to use here. - real, intent(in) :: dtbt !< The time step [s]. + real, intent(in) :: dtbt !< The time step [T ~> s]. real, intent(in) :: bebt !< The fractional weighting of the future velocity !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points - !! [H m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points - !! [H m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2426,21 +2424,21 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 !< A correction to the zonal transport so that !! the barotropic functions agree with the sum !! of the layer transports - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 !< A correction to the meridional transport so that !! the barotropic functions agree with the sum !! of the layer transports - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. ! Local variables - real :: vel_prev ! The previous velocity [m s-1]. + 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 [m s-1]. + ! 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 - real :: v_inlet + 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 :: h_in real :: cff, Cx, Cy, tau real :: dhdt, dhdx, dhdy @@ -2459,7 +2457,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = ubt(I,j) elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + 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) @@ -2473,13 +2471,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then if (OBC%segment(OBC%segnum_u(I,j))%Flather) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + 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)) + & + 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)) vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) @@ -2491,7 +2489,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, if (.not. OBC%segment(OBC%segnum_u(I,j))%specified) then if (use_BT_cont) then - uhbt(I,j) = find_uhbt(vel_trans,BTCL_u(I,j)) + uhbt0(I,j) + uhbt(I,j) = find_uhbt(vel_trans, BTCL_u(I,j), US) + uhbt0(I,j) else uhbt(I,j) = Datu(I,j)*vel_trans + uhbt0(I,j) endif @@ -2509,13 +2507,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vel_trans = vbt(i,J) elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + 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)) + & + 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))) vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) @@ -2525,13 +2523,13 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, endif elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then if (OBC%segment(OBC%segnum_v(i,J))%Flather) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + 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)) + & + 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)) vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) @@ -2543,7 +2541,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, if (.not. OBC%segment(OBC%segnum_v(i,J))%specified) then if (use_BT_cont) then - vhbt(i,J) = find_vhbt(vel_trans,BTCL_v(i,J)) + vhbt0(i,J) + vhbt(i,J) = find_vhbt(vel_trans, BTCL_v(i,J), US) + vhbt0(i,J) else vhbt(i,J) = vel_trans*Datv(i,J) + vhbt0(i,J) endif @@ -2557,7 +2555,7 @@ 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, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v) +subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v) type(ocean_OBC_type), pointer :: 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. @@ -2569,13 +2567,14 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co type(MOM_domain_type), intent(inout) :: BT_Domain !< MOM_domain_type associated with wide arrays 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 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. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points - !! [H m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points - !! [H m ~> m2 or kg m-1]. + !! [H L ~> m2 or kg m-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2640,7 +2639,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co ! Can this go in segment loop above? Is loop above wrong for wide halos?? if (OBC%segment(OBC%segnum_u(I,j))%specified) then if (use_BT_cont) then - BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j),BTCL_u(I,j)) + BT_OBC%ubt_outer(I,j) = uhbt_to_ubt(BT_OBC%uhbt(I,j), BTCL_u(I,j), US) else if (Datu(I,j) > 0.0) BT_OBC%ubt_outer(I,j) = BT_OBC%uhbt(I,j) / Datu(I,j) endif @@ -2692,7 +2691,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co ! Can this go in segment loop above? Is loop above wrong for wide halos?? if (OBC%segment(OBC%segnum_v(i,J))%specified) then if (use_BT_cont) then - BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J),BTCL_v(i,J)) + BT_OBC%vbt_outer(i,J) = vhbt_to_vbt(BT_OBC%vhbt(i,J), BTCL_v(i,J), US) else if (Datv(i,J) > 0.0) BT_OBC%vbt_outer(i,J) = BT_OBC%vhbt(i,J) / Datv(i,J) endif @@ -3030,13 +3029,14 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) end subroutine btcalc !> The function find_uhbt determines the zonal transport for a given velocity. -function find_uhbt(u, BTC) result(uhbt) - real, intent(in) :: u !< The local zonal velocity [m s-1] +function find_uhbt(u, BTC, US) result(uhbt) + real, intent(in) :: u !< The local zonal velocity [L T-1 ~> m s-1] type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real :: uhbt !< The result + real :: uhbt !< The zonal barotropic transport [L2 H T-1 ~> m3 s-1] if (u == 0.0) then uhbt = 0.0 @@ -3049,25 +3049,28 @@ function find_uhbt(u, BTC) result(uhbt) else ! (u > BTC%uBT_WW) uhbt = (u - BTC%uBT_WW) * BTC%FA_u_WW + BTC%uh_WW endif + end function find_uhbt !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport. -function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) +function uhbt_to_ubt(uhbt, BTC, US, guess) result(ubt) real, intent(in) :: uhbt !< The barotropic zonal transport that should be inverted for, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently with the !! layers' continuity equations. - real, optional, intent(in) :: guess !< A guess at what ubt will be. The result is not allowed - !! to be dramatically larger than guess. - real :: ubt !< The result - The velocity that gives uhbt transport [m s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, optional, intent(in) :: guess !< A guess at what ubt will be [L T-1 ~> m s-1]. The result + !! is not allowed to be dramatically larger than guess. + real :: ubt !< The result - The velocity that gives uhbt transport [L T-1 ~> m s-1]. ! Local variables real :: ubt_min, ubt_max, uhbt_err, derr_du real :: uherr_min, uherr_max - real, parameter :: tol = 1.0e-10 - real :: dvel, vsr ! Temporary variables used in the limiting the velocity. + real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim] + real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1]. + real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the ! maximum increase of vs2, both nondim. @@ -3144,12 +3147,13 @@ function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) end function uhbt_to_ubt !> The function find_vhbt determines the meridional transport for a given velocity. -function find_vhbt(v, BTC) result(vhbt) - real, intent(in) :: v !< The local meridional velocity [m s-1] +function find_vhbt(v, BTC, US) result(vhbt) + real, intent(in) :: v !< The local meridional velocity [L T-1 ~> m s-1] type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that !! allow the barotropic transports to be calculated consistently !! with the layers' continuity equations. - real :: vhbt !< The result + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real :: vhbt !< The meridional barotropic transport [L2 H T-1 ~> m3 s-1] if (v == 0.0) then vhbt = 0.0 @@ -3162,25 +3166,28 @@ function find_vhbt(v, BTC) result(vhbt) else ! (v > BTC%vBT_SS) vhbt = (v - BTC%vBT_SS) * BTC%FA_v_SS + BTC%vh_SS endif + end function find_vhbt !> This function inverts the transport function to determine the barotopic !! velocity that is consistent with a given transport. -function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) +function vhbt_to_vbt(vhbt, BTC, US, guess) result(vbt) real, intent(in) :: vhbt !< The barotropic meridional transport that should be - !! inverted for [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! inverted for [H L2 T-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that allow the !! barotropic transports to be calculated consistently !! with the layers' continuity equations. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, optional, intent(in) :: guess !< A guess at what vbt will be. The result is not allowed - !! to be dramatically larger than guess. - real :: vbt !< The result - The velocity that gives vhbt transport [m s-1]. + !! to be dramatically larger than guess [L T-1 ~> m s-1]. + real :: vbt !< The result - The velocity that gives vhbt transport [L T-1 ~> m s-1]. ! Local variables real :: vbt_min, vbt_max, vhbt_err, derr_dv real :: vherr_min, vherr_max - real, parameter :: tol = 1.0e-10 - real :: dvel, vsr ! Temporary variables used in the limiting the velocity. + real, parameter :: tol = 1.0e-10 ! A fractional match tolerance [nondim] + real :: dvel ! Temporary variable used in the limiting the velocity [L T-1 ~> m s-1]. + real :: vsr ! Temporary variable used in the limiting the velocity [nondim]. real, parameter :: vs1 = 1.25 ! Nondimensional parameters used in limiting real, parameter :: vs2 = 2.0 ! the velocity, starting at vs1, with the ! maximum increase of vs2, both nondim. @@ -3258,7 +3265,7 @@ end function vhbt_to_vbt !> This subroutine sets up reordered versions of the BT_cont type in the !! local_BT_cont types, which have wide halos properly filled in. -subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, halo) +subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, US, MS, BT_Domain, halo) type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the !! barotropic solver. type(memory_size_type), intent(in) :: MS !< A type that describes the @@ -3269,6 +3276,7 @@ subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, ha type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v !< A structure with the v !! information from BT_cont. 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(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for updating !! the halos of wide arrays. integer, optional, intent(in) :: halo !< The extra halo size to use here. @@ -3388,23 +3396,24 @@ end subroutine set_local_BT_cont_types !> Adjust_local_BT_cont_types sets up reordered versions of the BT_cont type !! in the local_BT_cont types, which have wide halos properly filled in. subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & - G, MS, halo) + G, US, MS, halo) 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(in) :: ubt !< The linearization zonal barotropic velocity [m s-1]. + intent(in) :: ubt !< The linearization zonal barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIBW_(MS),SZJW_(MS)), & intent(in) :: uhbt !< The linearization zonal barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & - intent(in) :: vbt !< The linearization meridional barotropic velocity [m s-1]. + intent(in) :: vbt !< The linearization meridional barotropic velocity [L T-1 ~> m s-1]. real, dimension(SZIW_(MS),SZJBW_(MS)), & intent(in) :: vhbt !< The linearization meridional barotropic transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & intent(out) :: BTCL_u !< A structure with the u information from BT_cont. type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & intent(out) :: BTCL_v !< A structure with the v information from BT_cont. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The extra halo size to use here. ! Local variables @@ -3450,26 +3459,26 @@ subroutine adjust_local_BT_cont_types(ubt, uhbt, vbt, vhbt, BTCL_u, BTCL_v, & !$OMP parallel do default(shared) do J=js-hs-1,je+hs ; do i=is-hs,ie+hs if ((vbt(i,J) > BTCL_v(i,J)%vBT_SS) .and. (vhbt(i,J) > BTCL_v(i,J)%vh_SS)) then - ! Nxpand the cubic fit to use this new point. vbt is negative. + ! Expand the cubic fit to use this new point. vbt is negative. BTCL_v(i,J)%vbt_SS = vbt(i,J) if (3.0*vhbt(i,J) < 2.0*vbt(i,J) * BTCL_v(i,J)%FA_v_S0) then - ! No fvrther bovnding is needed. + ! No further bounding is needed. BTCL_v(i,J)%vh_crvS = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_S0) / vbt(i,J)**3 - else ! This shovld not happen often! - BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / vbt(i,J) + else ! This should not happen often! + BTCL_v(i,J)%FA_v_S0 = 1.5*vhbt(i,J) / (vbt(i,J)) BTCL_v(i,J)%vh_crvS = -0.5*vhbt(i,J) / vbt(i,J)**3 endif BTCL_v(i,J)%vh_SS = vhbt(i,J) ! I don't know whether this is helpful. ! BTCL_v(i,J)%FA_v_SS = min(BTCL_v(i,J)%FA_v_SS, vhbt(i,J) / vbt(i,J)) elseif ((vbt(i,J) < BTCL_v(i,J)%vBT_NN) .and. (vhbt(i,J) < BTCL_v(i,J)%vh_NN)) then - ! Nxpand the cubic fit to use this new point. vbt is negative. + ! Expand the cubic fit to use this new point. vbt is negative. BTCL_v(i,J)%vbt_NN = vbt(i,J) if (3.0*vhbt(i,J) < 2.0*vbt(i,J) * BTCL_v(i,J)%FA_v_N0) then - ! No fvrther bovnding is needed. + ! No further bounding is needed. BTCL_v(i,J)%vh_crvN = (vhbt(i,J) - vbt(i,J) * BTCL_v(i,J)%FA_v_N0) / vbt(i,J)**3 - else ! This shovld not happen often! - BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / vbt(i,J) + else ! This should not happen often! + BTCL_v(i,J)%FA_v_N0 = 1.5*vhbt(i,J) / (vbt(i,J)) BTCL_v(i,J)%vh_crvN = -0.5*vhbt(i,J) / vbt(i,J)**3 endif BTCL_v(i,J)%vh_NN = vhbt(i,J) @@ -3482,16 +3491,17 @@ end subroutine adjust_local_BT_cont_types !> This subroutine uses the BTCL types to find typical or maximum face !! areas, which can then be used for finding wave speeds, etc. -subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) +subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo, maximize) type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the !! barotropic solver. type(memory_size_type), intent(in) :: MS !< A type that describes the memory !! sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The effective zonal face area [H m ~> m2 or kg m-1]. + intent(out) :: Datu !< The effective zonal face area [H L ~> m2 or kg m-1]. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The effective meridional face area [H m ~> m2 or kg m-1]. + intent(out) :: Datv !< The effective meridional face area [H L ~> m2 or kg m-1]. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: halo !< The extra halo size to use here. logical, optional, intent(in) :: maximize !< If present and true, find the !! maximum face area for any velocity. @@ -3533,14 +3543,15 @@ end subroutine swap !> This subroutine determines the open face areas of cells for calculating !! the barotropic transport. -subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, eta, halo, add_max) +subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes of the argument arrays. real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & - intent(out) :: Datu !< The open zonal face area [H m ~> m2 or kg m-1]. + intent(out) :: Datu !< The open zonal face area [H L ~> m2 or kg m-1]. real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & - intent(out) :: Datv !< The open meridional face area [H m ~> m2 or kg m-1]. + intent(out) :: Datv !< The open meridional face area [H L ~> m2 or kg m-1]. 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(barotropic_CS), pointer :: CS !< The control structure returned by a previous !! call to barotropic_init. real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & @@ -3698,9 +3709,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), & @@ -3727,9 +3738,9 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, #include "version_variable.h" ! Local variables character(len=40) :: mdl = "MOM_barotropic" ! This module's name. - real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H m ~> m2 or kg m-1]. - real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H m ~> m2 or kg m-1]. - real :: gtot_estimate ! Summed GV%g_prime [m2 Z-1 s-2 ~> m s-2], to give an upper-bound estimate for pbce. + 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 :: 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, dtbt_tmp @@ -3740,8 +3751,10 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! drag piston velocity. character(len=80) :: wave_drag_var ! The wave drag piston velocity variable ! name in wave_drag_file. - real :: uH_rescale ! A rescaling factor for thickness transports from the representation in - ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for horizontal velocity from the representation in + ! a restart file to the internal representation in this run. + real :: uH_rescale ! A rescaling factor for thickness transports from the representation in + ! a restart file to the internal representation in this run. real, allocatable, dimension(:,:) :: lin_drag_h type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -3861,12 +3874,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "The length scale at which the Rayleigh damping rate due "//& "to the ice strength should be the same as if a Laplacian "//& "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", & - units="m", default=1.0e4) + units="m", default=1.0e4, scale=US%m_to_L) call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & "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) + "DYNAMIC_SURFACE_PRESSURE is true..", & + units="m", default=1.0e-6, scale=US%m_to_Z) 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 "//& @@ -3942,7 +3955,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity) 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, & + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T, & do_not_log=.not.CS%clip_velocity) call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & "The maximum permitted CFL number associated with the "//& @@ -3953,7 +3966,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, & "A time-scale over which the barotropic mode solutions "//& @@ -3961,6 +3974,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "of DT if negative. When used this can never be taken to "//& "be longer than 2*dt. Set this to 0 to apply no filtering.", & units="sec or nondim", default=-0.25) + if (CS%dt_bt_filter > 0.0) CS%dt_bt_filter = US%s_to_T*CS%dt_bt_filter call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, & "A nondimensional factor by which gtot is enhanced.", & units="nondim", default=0.0) @@ -4076,7 +4090,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%bathyT(i,j) = G%bathyT(i,j) enddo ; enddo - ! Note: G%IdxCu & G%IdyCv may be smaller than CS%IdxCu & CS%IdyCv, even without + ! Note: G%IdxCu & G%IdyCv may be valid for a smaller extent than CS%IdxCu & CS%IdyCv, even without ! wide halos. do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB CS%IdxCu(I,j) = G%IdxCu(I,j) ; CS%dy_Cu(I,j) = G%dy_Cu(I,j) @@ -4086,10 +4100,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, enddo ; enddo call create_group_pass(pass_static_data, CS%IareaT, CS%BT_domain, To_All) call create_group_pass(pass_static_data, CS%bathyT, CS%BT_domain, To_All) - call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, & - To_All+Scalar_Pair) - call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, & - To_All+Scalar_Pair) + call create_group_pass(pass_static_data, CS%IdxCu, CS%IdyCv, CS%BT_domain, To_All+Scalar_Pair) + call create_group_pass(pass_static_data, CS%dy_Cu, CS%dx_Cv, CS%BT_domain, To_All+Scalar_Pair) call do_group_pass(pass_static_data, CS%BT_domain) if (CS%linearized_BT_PV) then @@ -4105,7 +4117,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, 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 * US%s_to_T*G%CoriolisBu(I,J) * & + CS%q_D(I,J) = 0.25 * G%CoriolisBu(I,J) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & ((G%areaT(i,j) * G%bathyT(i,j) + G%areaT(i+1,j+1) * G%bathyT(i+1,j+1)) + & (G%areaT(i+1,j) * G%bathyT(i+1,j) + G%areaT(i,j+1) * G%bathyT(i,j+1)) ) @@ -4130,16 +4142,16 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file) call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file) - allocate(lin_drag_h(isd:ied,jsd:jed)) ; CS%lin_drag_u(:,:) = 0.0 + allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0 - call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain) + 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 pass_var(lin_drag_h, G%Domain) do j=js,je ; do I=is-1,ie - CS%lin_drag_u(I,j) = (GV%m_to_H * wave_drag_scale) * & + 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)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%lin_drag_v(i,J) = (GV%m_to_H * wave_drag_scale) * & + 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)) enddo ; enddo deallocate(lin_drag_h) @@ -4176,38 +4188,38 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif CS%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, Time, & - 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2') + 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, Time, & - 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2') + 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, Time, & - 'Zonal Barotropic Coriolis Acceleration', 'm s-2') + 'Zonal Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_Corv_bt = register_diag_field('ocean_model', 'CorvBT', diag%axesCv1, Time, & - 'Meridional Barotropic Coriolis Acceleration', 'm s-2') + 'Meridional Barotropic Coriolis Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uaccel = register_diag_field('ocean_model', 'u_accel_bt', diag%axesCu1, Time, & - 'Barotropic zonal acceleration', 'm s-2') + 'Barotropic zonal acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_vaccel = register_diag_field('ocean_model', 'v_accel_bt', diag%axesCv1, Time, & - 'Barotropic meridional acceleration', 'm s-2') + 'Barotropic meridional acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ubtforce = register_diag_field('ocean_model', 'ubtforce', diag%axesCu1, Time, & - 'Barotropic zonal acceleration from baroclinic terms', 'm s-2') + 'Barotropic zonal acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_vbtforce = register_diag_field('ocean_model', 'vbtforce', diag%axesCv1, Time, & - 'Barotropic meridional acceleration from baroclinic terms', 'm s-2') + 'Barotropic meridional acceleration from baroclinic terms', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_eta_bt = register_diag_field('ocean_model', 'eta_bt', diag%axesT1, Time, & 'Barotropic end SSH', thickness_units) CS%id_ubt = register_diag_field('ocean_model', 'ubt', diag%axesCu1, Time, & - 'Barotropic end zonal velocity', 'm s-1') + 'Barotropic end zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbt = register_diag_field('ocean_model', 'vbt', diag%axesCv1, Time, & - 'Barotropic end meridional velocity', 'm s-1') + 'Barotropic end meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_st = register_diag_field('ocean_model', 'eta_st', diag%axesT1, Time, & 'Barotropic start SSH', thickness_units) CS%id_ubt_st = register_diag_field('ocean_model', 'ubt_st', diag%axesCu1, Time, & - 'Barotropic start zonal velocity', 'm s-1') + 'Barotropic start zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbt_st = register_diag_field('ocean_model', 'vbt_st', diag%axesCv1, Time, & - 'Barotropic start meridional velocity', 'm s-1') + 'Barotropic start meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_ubtav = register_diag_field('ocean_model', 'ubtav', diag%axesCu1, Time, & - 'Barotropic time-average zonal velocity', 'm s-1') + 'Barotropic time-average zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbtav = register_diag_field('ocean_model', 'vbtav', diag%axesCv1, Time, & - 'Barotropic time-average meridional velocity', 'm s-1') + 'Barotropic time-average meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_cor = register_diag_field('ocean_model', 'eta_cor', diag%axesT1, Time, & 'Corrective mass flux', 'm s-1') CS%id_visc_rem_u = register_diag_field('ocean_model', 'visc_rem_u', diag%axesCuL, Time, & @@ -4215,19 +4227,19 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, CS%id_visc_rem_v = register_diag_field('ocean_model', 'visc_rem_v', diag%axesCvL, Time, & 'Viscous remnant at v', 'nondim') CS%id_gtotn = register_diag_field('ocean_model', 'gtot_n', diag%axesT1, Time, & - 'gtot to North', 'm s-2') + 'gtot to North', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_gtots = register_diag_field('ocean_model', 'gtot_s', diag%axesT1, Time, & - 'gtot to South', 'm s-2') + 'gtot to South', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_gtote = register_diag_field('ocean_model', 'gtot_e', diag%axesT1, Time, & - 'gtot to East', 'm s-2') + 'gtot to East', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_gtotw = register_diag_field('ocean_model', 'gtot_w', diag%axesT1, Time, & - 'gtot to West', 'm s-2') + 'gtot to West', 'm s-2', conversion=US%L_T_to_m_s**2) CS%id_eta_hifreq = register_diag_field('ocean_model', 'eta_hifreq', diag%axesT1, Time, & 'High Frequency Barotropic SSH', thickness_units) CS%id_ubt_hifreq = register_diag_field('ocean_model', 'ubt_hifreq', diag%axesCu1, Time, & - 'High Frequency Barotropic zonal velocity', 'm s-1') + 'High Frequency Barotropic zonal velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vbt_hifreq = register_diag_field('ocean_model', 'vbt_hifreq', diag%axesCv1, Time, & - 'High Frequency Barotropic meridional velocity', 'm s-1') + 'High Frequency Barotropic meridional velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_eta_pred_hifreq = register_diag_field('ocean_model', 'eta_pred_hifreq', diag%axesT1, Time, & 'High Frequency Predictor Barotropic SSH', thickness_units) CS%id_uhbt_hifreq = register_diag_field('ocean_model', 'uhbt_hifreq', diag%axesCu1, Time, & @@ -4249,34 +4261,34 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (use_BT_cont_type) then CS%id_BTC_FA_u_EE = register_diag_field('ocean_model', 'BTC_FA_u_EE', diag%axesCu1, Time, & - 'BTCont type far east face area', 'm2') + 'BTCont type far east face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_E0 = register_diag_field('ocean_model', 'BTC_FA_u_E0', diag%axesCu1, Time, & - 'BTCont type near east face area', 'm2') + 'BTCont type near east face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_WW = register_diag_field('ocean_model', 'BTC_FA_u_WW', diag%axesCu1, Time, & - 'BTCont type far west face area', 'm2') + 'BTCont type far west face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_u_W0 = register_diag_field('ocean_model', 'BTC_FA_u_W0', diag%axesCu1, Time, & - 'BTCont type near west face area', 'm2') + 'BTCont type near west face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_ubt_EE = register_diag_field('ocean_model', 'BTC_ubt_EE', diag%axesCu1, Time, & 'BTCont type far east velocity', 'm s-1') CS%id_BTC_ubt_WW = register_diag_field('ocean_model', 'BTC_ubt_WW', diag%axesCu1, Time, & 'BTCont type far west velocity', 'm s-1') CS%id_BTC_FA_v_NN = register_diag_field('ocean_model', 'BTC_FA_v_NN', diag%axesCv1, Time, & - 'BTCont type far north face area', 'm2') + 'BTCont type far north face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_N0 = register_diag_field('ocean_model', 'BTC_FA_v_N0', diag%axesCv1, Time, & - 'BTCont type near north face area', 'm2') + 'BTCont type near north face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_SS = register_diag_field('ocean_model', 'BTC_FA_v_SS', diag%axesCv1, Time, & - 'BTCont type far south face area', 'm2') + 'BTCont type far south face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_FA_v_S0 = register_diag_field('ocean_model', 'BTC_FA_v_S0', diag%axesCv1, Time, & - 'BTCont type near south face area', 'm2') + 'BTCont type near south face area', 'm2', conversion=US%L_to_m*GV%H_to_m) CS%id_BTC_vbt_NN = register_diag_field('ocean_model', 'BTC_vbt_NN', diag%axesCv1, Time, & - 'BTCont type far north velocity', 'm s-1') + 'BTCont type far north velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_BTC_vbt_SS = register_diag_field('ocean_model', 'BTC_vbt_SS', diag%axesCv1, Time, & - 'BTCont type far south velocity', 'm s-1') + 'BTCont type far south velocity', 'm s-1', conversion=US%L_T_to_m_s) endif CS%id_uhbt0 = register_diag_field('ocean_model', 'uhbt0', diag%axesCu1, Time, & - 'Barotropic zonal transport difference', 'm3 s-1') + 'Barotropic zonal transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_vhbt0 = register_diag_field('ocean_model', 'vhbt0', diag%axesCv1, Time, & - 'Barotropic meridional transport difference', 'm3 s-1') + 'Barotropic meridional transport difference', 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) if (CS%id_frhatu1 > 0) call safe_alloc_ptr(CS%frhatu1, IsdB,IedB,jsd,jed,nz) if (CS%id_frhatv1 > 0) call safe_alloc_ptr(CS%frhatv1, isd,ied,JsdB,JedB,nz) @@ -4291,12 +4303,21 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, do k=1,nz ; do J=js-1,je ; do i=is,ie CS%vbtav(i,J) = CS%vbtav(i,J) + CS%frhatv(i,J,k) * v(i,J,k) enddo ; enddo ; enddo + elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + do j=js,je ; do I=is-1,ie ; CS%ubtav(I,j) = vel_rescale * CS%ubtav(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vbtav(i,J) = vel_rescale * CS%vbtav(I,j) ; enddo ; enddo endif if (.NOT.query_initialized(CS%ubt_IC,"ubt_IC",restart_CS) .or. & .NOT.query_initialized(CS%vbt_IC,"vbt_IC",restart_CS)) then do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = CS%ubtav(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = CS%vbtav(i,J) ; enddo ; enddo + elseif ((US%s_to_T_restart*US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L*US%s_to_T_restart) /= (US%m_to_L_restart*US%s_to_T)) then + vel_rescale = (US%m_to_L*US%s_to_T_restart) / (US%m_to_L_restart*US%s_to_T) + do j=js,je ; do I=is-1,ie ; CS%ubt_IC(I,j) = vel_rescale * CS%ubt_IC(I,j) ; enddo ; enddo + do J=js-1,je ; do i=is,ie ; CS%vbt_IC(i,J) = vel_rescale * CS%vbt_IC(I,j) ; enddo ; enddo endif ! Calculate other constants which are used for btstep. @@ -4326,7 +4347,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! enddo ; enddo ! endif - call find_face_areas(Datu, Datv, G, GV, CS, MS, halo=1) + call find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo=1) if (CS%bound_BT_corr) then ! ### Consider replacing maxvel with G%dxT(i,j) * (CS%maxCFL_BT_cont*Idt) ! ### and G%dyT(i,j) * (CS%maxCFL_BT_cont*Idt) @@ -4340,8 +4361,11 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, .NOT.query_initialized(CS%vhbt_IC,"vhbt_IC",restart_CS)) then do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = CS%ubtav(I,j) * Datu(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = CS%vbtav(i,J) * Datv(i,J) ; enddo ; enddo - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - uH_rescale = GV%m_to_H / GV%m_to_H_restart + elseif ((US%s_to_T_restart * US%m_to_L_restart * GV%m_to_H_restart /= 0.0) .and. & + ((US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) /= & + (US%s_to_T * US%m_to_L_restart**2 * GV%m_to_H_restart))) then + uH_rescale = (US%s_to_T_restart * US%m_to_L**2 * GV%m_to_H) / & + (US%s_to_T * US%m_to_L_restart**2 * GV%m_to_H_restart) do j=js,je ; do I=is-1,ie ; CS%uhbt_IC(I,j) = uH_rescale * CS%uhbt_IC(I,j) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; CS%vhbt_IC(i,J) = uH_rescale * CS%vhbt_IC(I,j) ; enddo ; enddo endif @@ -4364,22 +4388,22 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, end subroutine barotropic_init !> Copies ubtav and vbtav from private type into arrays -subroutine barotropic_get_tav(CS, ubtav, vbtav, G) - type(barotropic_CS), pointer :: CS !< Control structure for - !! this module - type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav!< zonal barotropic vel. - !! ave. over baroclinic time-step (m s-1) - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav!< meridional barotropic vel. - !! ave. over baroclinic time-step (m s-1) +subroutine barotropic_get_tav(CS, ubtav, vbtav, G, US) + type(barotropic_CS), pointer :: CS !< Control structure for this module + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: ubtav !< Zonal barotropic velocity averaged + !! over a baroclinic timestep [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vbtav !< Meridional barotropic velocity averaged + !! over a baroclinic timestep [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j - do j = G%jsc, G%jec ; do I = G%isc-1, G%iec + do j=G%jsc,G%jec ; do I=G%isc-1,G%iec ubtav(I,j) = CS%ubtav(I,j) enddo ; enddo - do J = G%jsc-1, G%jec ; do i = G%isc, G%iec + do J=G%jsc-1,G%jec ; do i=G%isc,G%iec vbtav(i,J) = CS%vbtav(i,J) enddo ; enddo diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index ae78c6fd0d..c3ed3c705b 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -146,7 +146,7 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) if (CS%use_dyed_channel) & call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, Time) if (OBC%needs_IO_for_data) & - call update_OBC_segment_data(G, GV, OBC, tv, h, Time) + call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) end subroutine update_OBC_data diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index a71f4bab48..e8347881f7 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -10,6 +10,7 @@ module MOM_checksum_packages use MOM_domains, only : sum_across_PEs, min_across_PEs, max_across_PEs use MOM_error_handler, only : MOM_mesg, is_root_pe use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalGrid, only : verticalGrid_type @@ -38,69 +39,78 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, vel_scale) character(len=*), & intent(in) :: mesg !< A message that appears on the chksum lines. 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Volume flux through meridional faces = v*h*dx - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. + real, optional, intent(in) :: vel_scale !< The scaling factor to convert velocities to [m s-1] - integer :: is, ie, js, je, nz, hs + real :: scale_vel ! The scaling factor to convert velocities to [m s-1] logical :: sym + integer :: is, ie, js, je, nz, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - hs=1; if (present(haloshift)) hs=haloshift - sym=.false.; if (present(symmetric)) sym=symmetric - call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym) + hs = 1 ; if (present(haloshift)) hs=haloshift + sym = .false. ; if (present(symmetric)) sym=symmetric + scale_vel = US%L_T_to_m_s ; if (present(vel_scale)) scale_vel = vel_scale + + call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, scale=scale_vel) call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & - symmetric=sym, scale=GV%H_to_m) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= !> Write out chksums for the model's basic state variables. -subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) - character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. +subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] or [m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). - logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. - + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is + !! used to rescale u and v if present. + integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully + !! symmetric computational domain. + real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> nondim] or [nondim] integer :: is, ie, js, je, nz, hs logical :: sym + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + L_T_to_m_s = 1.0 ; if (present(US)) L_T_to_m_s = US%L_T_to_m_s ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. hs=1; if (present(haloshift)) hs=haloshift sym=.false.; if (present(symmetric)) sym=symmetric - call uvchksum(mesg//" u", u, v, G%HI,haloshift=hs, symmetric=sym) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg @@ -136,7 +146,7 @@ subroutine MOM_surface_chksum(mesg, sfc, G, haloshift, symmetric) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: hs logical :: sym @@ -158,41 +168,42 @@ end subroutine MOM_surface_chksum ! ============================================================================= !> Write out chksums for the model's accelerations -subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, & +subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, US, pbce, & u_accel_bt, v_accel_bt, symmetric) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: CAu !< Zonal acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: CAv !< Meridional acceleration due to Coriolis - !! and momentum advection terms [m s-2]. + !! and momentum advection terms [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: PFu !< Zonal acceleration due to pressure gradients - !! (equal to -dM/dx) [m s-2]. + !! (equal to -dM/dx) [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: PFv !< Meridional acceleration due to pressure gradients - !! (equal to -dM/dy) [m s-2]. + !! (equal to -dM/dy) [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: diffu !< Zonal acceleration due to convergence of the - !! along-isopycnal stress tensor [m s-2]. + !! along-isopycnal stress tensor [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: diffv !< Meridional acceleration due to convergence of - !! the along-isopycnal stress tensor [m s-2]. + !! the along-isopycnal stress tensor [L T-2 ~> m s-2]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies - !! [m2 s-2 H-1 ~> m s-2 or m4 s-2 kg-1]. + !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the - !! barotropic solver [m s-2]. + !! barotropic solver [L T-2 ~> m s-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in - !! the barotropic solver [m s-2]. + !! the barotropic solver [L T-2 ~> m s-2]. logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric - !! computationoal domain. + !! computational domain. integer :: is, ie, js, je, nz logical :: sym @@ -203,59 +214,69 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. - call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym) - call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym) - call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym) + call uvchksum(mesg//" CA[uv]", CAu, CAv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) + call uvchksum(mesg//" PF[uv]", PFu, PFv, G%HI, haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) + call uvchksum(mesg//" diffu", diffu, diffv, G%HI,haloshift=0, symmetric=sym, scale=US%L_T2_to_m_s2) if (present(pbce)) & - call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H) + call hchksum(pbce, mesg//" pbce",G%HI,haloshift=0, scale=GV%m_to_H*US%L_T_to_m_s**2) if (present(u_accel_bt) .and. present(v_accel_bt)) & - call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym) + call uvchksum(mesg//" [uv]_accel_bt", u_accel_bt, v_accel_bt, G%HI,haloshift=0, symmetric=sym, & + scale=US%L_T2_to_m_s2) end subroutine MOM_accel_chksum ! ============================================================================= !> Monitor and write out statistics for the model's state variables. -subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing) +subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, permitDiminishing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, pointer, dimension(:,:,:), & intent(in) :: Temp !< Temperature [degC]. real, pointer, dimension(:,:,:), & intent(in) :: Salt !< Salinity [ppt]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: allowChange !< do not flag an error !! if the statistics change. - logical, optional, intent(in) :: permitDiminishing !< do not flag error - !!if the extrema are diminishing. + logical, optional, intent(in) :: permitDiminishing !< do not flag error if the + !! extrema are diminishing. + ! Local variables - integer :: is, ie, js, je, nz, i, j, k - real :: Vol, dV, Area, h_minimum + real :: Vol, dV ! The total ocean volume and its change [m3] (unscaled to permit reproducing sum). + real :: Area ! The total ocean surface area [m2] (unscaled to permit reproducing sum). + real :: h_minimum ! The minimum layer thicknesses [H ~> m or kg m-2] + logical :: do_TS ! If true, evaluate statistics for temperature and salinity type(stats) :: T, S, delT, delS - type(stats), save :: oldT, oldS ! NOTE: save data is not normally allowed but - logical, save :: firstCall = .true. ! we use it for debugging purposes here on the - logical :: do_TS - real, save :: oldVol ! assumption we will not turn this on with threads + + ! NOTE: save data is not normally allowed but we use it for debugging purposes here on the + ! assumption we will not turn this on with threads + type(stats), save :: oldT, oldS + logical, save :: firstCall = .true. + real, save :: oldVol ! The previous total ocean volume [m3] + character(len=80) :: lMsg - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: is, ie, js, je, nz, i, j, k + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do_TS = associated(Temp) .and. associated(Salt) ! First collect local stats Area = 0. ; Vol = 0. do j = js, je ; do i = is, ie - Area = Area + G%areaT(i,j) + Area = Area + US%L_to_m**2*G%areaT(i,j) enddo ; enddo T%minimum = 1.E34 ; T%maximum = -1.E34 ; T%average = 0. S%minimum = 1.E34 ; S%maximum = -1.E34 ; S%average = 0. - h_minimum = 1.E34 + h_minimum = 1.E34*GV%m_to_H do k = 1, nz ; do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then - dV = G%areaT(i,j)*h(i,j,k) ; Vol = Vol + dV + dV = US%L_to_m**2*G%areaT(i,j)*GV%H_to_m*h(i,j,k) ; Vol = Vol + dV if (do_TS .and. h(i,j,k)>0.) then T%minimum = min( T%minimum, Temp(i,j,k) ) ; T%maximum = max( T%maximum, Temp(i,j,k) ) T%average = T%average + dV*Temp(i,j,k) @@ -278,7 +299,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi delT%average = T%average - oldT%average delS%minimum = S%minimum - oldS%minimum ; delS%maximum = S%maximum - oldS%maximum delS%average = S%average - oldS%average - write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =',Vol/Area,' frac. delta=',dV/Vol + write(lMsg(1:80),'(2(a,es12.4))') 'Mean thickness =', Vol/Area,' frac. delta=',dV/Vol call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum @@ -291,12 +312,12 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi call MOM_mesg(lMsg//trim(mesg)) endif else - write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =',Vol/Area + write(lMsg(1:80),'(a,es12.4)') 'Mean thickness =', Vol/Area call MOM_mesg(lMsg//trim(mesg)) if (do_TS) then - write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =',T%minimum,T%average,T%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Temp min/mean/max =', T%minimum, T%average, T%maximum call MOM_mesg(lMsg//trim(mesg)) - write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =',S%minimum,S%average,S%maximum + write(lMsg(1:80),'(a,3es12.4)') 'Salt min/mean/max =', S%minimum, S%average, S%maximum call MOM_mesg(lMsg//trim(mesg)) endif endif @@ -308,10 +329,10 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi if (do_TS .and. T%minimum<-5.0) then do j = js, je ; do i = is, ie if (minval(Temp(i,j,:)) == T%minimum) then - write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) + write(0,'(a,2f12.5)') 'x,y=', G%geoLonT(i,j), G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Extremum detected' endif @@ -324,7 +345,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDimi write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j) write(0,'(a3,3a12)') 'k','h','Temp','Salt' do k = 1, nz - write(0,'(i3,3es12.4)') k,h(i,j,k),Temp(i,j,k),Salt(i,j,k) + write(0,'(i3,3es12.4)') k, h(i,j,k), Temp(i,j,k), Salt(i,j,k) enddo stop 'Negative thickness detected' endif diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index ce69c9816c..9aaa6f92fc 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -12,6 +12,7 @@ module MOM_continuity use MOM_string_functions, only : uppercase use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -38,33 +39,33 @@ module MOM_continuity !> Time steps the layer thicknesses, using a monotonically limited, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) +subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, uhbt, vhbt, OBC, & + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = - !! u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: vh !< Volume flux through meridional faces = - !! v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume - !! flux through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The vertically summed volume - !! flux through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! flux through meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -79,22 +80,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocities that - !! give uhbt as the depth-integrated transport [m s-1]. + !! give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocities that - !! give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux !< A second summed zonal - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux !< A second summed meridional - !! volume flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(inout) :: u_cor_aux !< The zonal velocities - !! that give uhbt_aux as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(inout) :: v_cor_aux !< The meridional velocities - !! that give vhbt_aux as the depth-integrated transport [m s-1]. + !! give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), & optional, pointer :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. @@ -105,21 +94,10 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & if (present(u_cor) .neqv. present(v_cor)) call MOM_error(FATAL, & "MOM_continuity: Either both u_cor and v_cor or neither"// & " one must be present in call to continuity.") - if (present(uhbt_aux) .neqv. present(vhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both uhbt_aux and uhbt_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(v_cor_aux)) call MOM_error(FATAL, & - "MOM_continuity: Either both u_cor_aux and v_cor_aux or neither"// & - " one must be present in call to continuity.") - if (present(u_cor_aux) .neqv. present(uhbt_aux)) call MOM_error(FATAL, & - "MOM_continuity: u_cor_aux can only be calculated if uhbt_aux is"// & - " provided, and uhbt_aux has no other purpose. Include both arguments"//& - " or neither.") if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS%PPM_CSp, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) + call continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS%PPM_CSp, uhbt, vhbt, OBC, & + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont=BT_cont) else call MOM_error(FATAL, "continuity: Unrecognized value of continuity_scheme") endif @@ -127,10 +105,11 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & end subroutine continuity !> Initializes continuity_cs -subroutine continuity_init(Time, G, GV, param_file, diag, CS) +subroutine continuity_init(Time, G, GV, US, param_file, diag, CS) 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. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handles. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. @@ -166,7 +145,7 @@ subroutine continuity_init(Time, G, GV, param_file, diag, CS) end select if (CS%continuity_scheme == PPM_SCHEME) then - call continuity_PPM_init(Time, G, GV, param_file, diag, CS%PPM_CSp) + call continuity_PPM_init(Time, G, GV, US, param_file, diag, CS%PPM_CSp) endif end subroutine continuity_init diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4cf410160b..8a8ecf9da5 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -10,6 +10,7 @@ module MOM_continuity_PPM use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -38,7 +39,7 @@ module MOM_continuity_PPM !! the sum of the layer thicknesses [H ~> m or kg m-2]. real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses [m s-1]. + !! the sum of the layer thicknesses [L T-1 ~> m s-1]. real :: tol_eta_aux !< The tolerance for free-surface height !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses when calculating @@ -72,31 +73,31 @@ module MOM_continuity_PPM !> Time steps the layer thicknesses, using a monotonically limit, directionally split PPM scheme, !! based on Lin (1994). -subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & - visc_rem_u, visc_rem_v, u_cor, v_cor, & - uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) +subroutine continuity_PPM(u, v, hin, h, uh, vh, dt_in_T, G, GV, US, CS, uhbt, vhbt, OBC, & + visc_rem_u, visc_rem_v, u_cor, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS !< Module's control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< Initial layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Final layer thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: uh !< Zonal volume flux, u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + intent(out) :: uh !< Zonal volume flux, u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: vh !< Meridional volume flux, v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + intent(out) :: vh !< Meridional volume flux, v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), & optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -115,26 +116,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor - !< The zonal velocities that give uhbt as the depth-integrated transport [m s-1]. + !< The zonal velocities that give uhbt as the depth-integrated transport [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor - !< The meridional velocities that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: vhbt_aux - !< A second set of summed volume fluxes through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities that give uhbt_aux as the depth-integrated - !! transports [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities that give vhbt_aux as the depth-integrated - !! transports [m s-1]. + !< The meridional velocities that give vhbt as the depth-integrated + !! transport [L T-1 ~> m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. @@ -163,13 +149,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! First, advect zonally. LB%ish = G%isc ; LB%ieh = G%iec LB%jsh = G%jsc-stencil ; LB%jeh = G%jec+stencil - call zonal_mass_flux(u, hin, uh, dt, G, GV, CS, LB, uhbt, OBC, visc_rem_u, & - u_cor, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, hin, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! Uncomment this line to prevent underflow. ! if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -179,13 +164,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, ! Now advect meridionally, using the updated thicknesses to determine ! the fluxes. - call meridional_mass_flux(v, h, vh, dt, G, GV, CS, LB, vhbt, OBC, visc_rem_v, & - v_cor, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, h, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -196,26 +180,24 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, LB%ish = G%isc-stencil ; LB%ieh = G%iec+stencil LB%jsh = G%jsc ; LB%jeh = G%jec - call meridional_mass_flux(v, hin, vh, dt, G, GV, CS, LB, vhbt, OBC, visc_rem_v, & - v_cor, vhbt_aux, v_cor_aux, BT_cont) + call meridional_mass_flux(v, hin, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, visc_rem_v, v_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = hin(i,j,k) - dt*G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) + h(i,j,k) = hin(i,j,k) - dt_in_T * G%IareaT(i,j) * (vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo ; enddo call cpu_clock_end(id_clock_update) ! Now advect zonally, using the updated thicknesses to determine ! the fluxes. LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec - call zonal_mass_flux(u, h, uh, dt, G, GV, CS, LB, uhbt, OBC, visc_rem_u, & - u_cor, uhbt_aux, u_cor_aux, BT_cont) + call zonal_mass_flux(u, h, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, visc_rem_u, u_cor, BT_cont) call cpu_clock_begin(id_clock_update) !$OMP parallel do default(shared) do k=1,nz ; do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - h(i,j,k) = h(i,j,k) - dt* G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * (uh(I,j,k) - uh(I-1,j,k)) ! This line prevents underflow. if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo @@ -226,18 +208,19 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, end subroutine continuity_PPM !> Calculates the mass or volume fluxes through the zonal faces, and other related quantities. -subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & - visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) +subroutine zonal_mass_flux(u, h_in, uh, dt_in_T, G, GV, US, CS, LB, uhbt, OBC, & + visc_rem_u, u_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Zonal velocity [m s-1]. + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: uh !< Volume flux through zonal faces = u*h*dy - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), & @@ -250,48 +233,40 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: uhbt_aux - !< A second set of summed volume fluxes through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: u_cor !< The zonal velocitiess (u with a barotropic correction) !! that give uhbt as the depth-integrated transport, m s-1. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: u_cor_aux - !< The zonal velocities (u with a barotropic correction) - !! that give uhbt_aux as the depth-integrated transports [m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of barotropic flow. ! Local variables - real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G),SZK_(G)) :: duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & - du, & ! Corrective barotropic change in the velocity [m s-1]. + du, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. du_min_CFL, & ! Min/max limits on du correction du_max_CFL, & ! to avoid CFL violations - duhdu_tot_0, & ! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. - uh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + duhdu_tot_0, & ! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. + uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZIB_(G)) :: do_I real, dimension(SZIB_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_u or an array of 1's. - real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H m ~> m2 or kg m-1]. + real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H L ~> m2 or kg m-1]. real :: FA_u ! A sum of zonal face areas [H m ~> m2 or kg m-1]. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: du_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: du_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dx_E, dx_W ! Effective x-grid spacings to the east and west [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, local_open_BC, is_simple type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(uhbt_aux) .and. present(u_cor_aux)) use_visc_rem = present(visc_rem_u) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -303,8 +278,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -325,8 +300,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,u,h_in,h_L,h_R,use_visc_rem,visc_rem_u, & -!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,do_aux,set_BT_cont, & -!$OMP CFL_dt,I_dt,u_cor,uhbt_aux,u_cor_aux,BT_cont, local_Flather_OBC) & +!$OMP uh,dt,G,GV,CS,local_specified_BC,OBC,uhbt,set_BT_cont, & +!$OMP CFL_dt,I_dt,u_cor,BT_cont, local_Flather_OBC) & !$OMP private(do_I,duhdu,du,du_max_CFL,du_min_CFL,uh_tot_0,duhdu_tot_0, & !$OMP is_simple,FAuI,visc_rem_max,I_vrm,du_lim,dx_E,dx_W,any_simple_OBC ) & !$OMP firstprivate(visc_rem) @@ -340,7 +315,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & enddo ; endif call zonal_flux_layer(u(:,j,k), h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh(:,j,k), duhdu(:,k), visc_rem(:,k), & - dt, G, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do I=ish-1,ieh if (OBC%segment(OBC%segnum_u(I,j))%specified) & @@ -353,7 +328,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & visc_rem_max(I) = 1.0 enddo ; endif - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then ! Set limits on du that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do I=ish-1,ieh @@ -430,10 +405,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & du_min_CFL(I) = min(du_min_CFL(I),0.0) enddo - ! Up to this point, everything is shared between uhbt and uhbt_aux. - any_simple_OBC = .false. - if (present(uhbt) .or. do_aux .or. set_BT_cont) then + if (present(uhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do I=ish-1,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_u(I,j))%specified @@ -445,9 +418,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & endif if (present(uhbt)) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., uh, OBC=OBC) + call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt(:,j), uh_tot_0, duhdu_tot_0, du, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., uh, OBC=OBC) if (present(u_cor)) then ; do k=1,nz do I=ish-1,ieh ; u_cor(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo @@ -459,23 +432,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & endif - if (do_aux) then - call zonal_flux_adjust(u, h_in, h_L, h_R, uhbt_aux(:,j), uh_tot_0, & - duhdu_tot_0, du, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do I=ish-1,ieh ; u_cor_aux(I,j,k) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo - if (local_specified_BC) then ; do I=ish-1,ieh - if (OBC%segment(OBC%segnum_u(I,j))%specified) & - u_cor_aux(I,j,k) = OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) - enddo ; endif - enddo - endif ! do_aux - if (set_BT_cont) then call set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0,& - du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) if (any_simple_OBC) then do I=ish-1,ieh @@ -489,15 +448,17 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & OBC%segment(OBC%segnum_u(I,j))%normal_vel(I,j,k) endif ; enddo ; enddo do I=ish-1,ieh ; if (do_I(I)) then - BT_cont%Fa_u_W0(I,j) = FAuI(I) ; BT_cont%Fa_u_E0(I,j) = FAuI(I) - BT_cont%Fa_u_WW(I,j) = FAuI(I) ; BT_cont%Fa_u_EE(I,j) = FAuI(I) + BT_cont%FA_u_W0(I,j) = FAuI(I) ; BT_cont%FA_u_E0(I,j) = FAuI(I) + BT_cont%FA_u_WW(I,j) = FAuI(I) ; BT_cont%FA_u_EE(I,j) = FAuI(I) BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 endif ; enddo endif endif ! set_BT_cont - endif ! present(uhbt) or do_aux or set_BT_cont + endif ! present(uhbt) or set_BT_cont + enddo ! j-loop + if (local_open_BC .and. set_BT_cont) then do n = 1, OBC%number_of_segments if (OBC%segment(n)%open .and. OBC%segment(n)%is_E_or_W) then @@ -506,16 +467,16 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 do k=1,nz ; FA_u = FA_u + h_in(i,j,k)*G%dy_Cu(I,j) ; enddo - BT_cont%Fa_u_W0(I,j) = FA_u ; BT_cont%Fa_u_E0(I,j) = FA_u - BT_cont%Fa_u_WW(I,j) = FA_u ; BT_cont%Fa_u_EE(I,j) = FA_u + BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u + BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 enddo else do J = OBC%segment(n)%HI%Jsd, OBC%segment(n)%HI%Jed FA_u = 0.0 do k=1,nz ; FA_u = FA_u + h_in(i+1,j,k)*G%dy_Cu(I,j) ; enddo - BT_cont%Fa_u_W0(I,j) = FA_u ; BT_cont%Fa_u_E0(I,j) = FA_u - BT_cont%Fa_u_WW(I,j) = FA_u ; BT_cont%Fa_u_EE(I,j) = FA_u + BT_cont%FA_u_W0(I,j) = FA_u ; BT_cont%FA_u_E0(I,j) = FA_u + BT_cont%FA_u_WW(I,j) = FA_u ; BT_cont%FA_u_EE(I,j) = FA_u BT_cont%uBT_WW(I,j) = 0.0 ; BT_cont%uBT_EE(I,j) = 0.0 enddo endif @@ -526,10 +487,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then if (present(u_cor)) then - call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) else - call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, LB, & + call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_u, OBC) endif endif ; endif @@ -537,10 +498,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & +subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt_in_T, G, US, j, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -550,10 +511,11 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & real, dimension(SZI_(G)), intent(in) :: h_L !< Left thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(in) :: h_R !< Right thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume - !! transport [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh - !! with u [H m ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! with u [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -577,15 +539,15 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & do I=ish-1,ieh ; if (do_I(I)) then ! Set new values of uh and duhdu. if (u(I) > 0.0) then - if (vol_CFL) then ; CFL = (u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i) + h_R(i) - 2.0*h(i) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_R(i) + CFL * (0.5*(h_L(i) - h_R(i)) + curv_3*(CFL - 1.5))) h_marg = h_R(i) + CFL * ((h_L(i) - h_R(i)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1) + h_R(i+1) - 2.0*h(i+1) uh(I) = G%dy_Cu(I,j) * u(I) * & (h_L(i+1) + CFL * (0.5*(h_R(i+1)-h_L(i+1)) + curv_3*(CFL - 1.5))) @@ -613,10 +575,10 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, j, & end subroutine zonal_flux_layer !> Sets the effective interface thickness at each zonal velocity point. -subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & +subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_u, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -624,7 +586,8 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. @@ -651,14 +614,14 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh if (u(I,j,k) > 0.0) then - if (vol_CFL) then ; CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) - else ; CFL = u(I,j,k) * dt * G%IdxT(i,j) ; endif + if (vol_CFL) then ; CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + else ; CFL = u(I,j,k) * dt_in_T * G%IdxT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + 3.0*curv_3*(CFL - 1.0)) elseif (u(I,j,k) < 0.0) then - if (vol_CFL) then ; CFL = (-u(I,j,k)*dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) - else ; CFL = -u(I,j,k) * dt * G%IdxT(i+1,j) ; endif + if (vol_CFL) then ; CFL = (-u(I,j,k)*dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + else ; CFL = -u(I,j,k) * dt_in_T * G%IdxT(i+1,j) ; endif curv_3 = h_L(i+1,j,k) + h_R(i+1,j,k) - 2.0*h(i+1,j,k) h_avg = h_L(i+1,j,k) + CFL * (0.5*(h_R(i+1,j,k)-h_L(i+1,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i+1,j,k) + CFL * ((h_R(i+1,j,k)-h_L(i+1,j,k)) + & @@ -720,10 +683,10 @@ end subroutine zonal_face_thickness !> Returns the barotropic velocity adjustment that gives the !! desired barotropic (layer-summed) transport. subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & - du, du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du, du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, uh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -736,19 +699,20 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G)), optional, intent(in) :: uhbt !< The summed volume flux - !! through zonal faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(out) :: du !< - !! The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -759,23 +723,23 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & !! A flag indicating how carefully to iterate. The !! default is .true. (more accurate). real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: uh_3d !< - !! Volume flux through zonal faces = u*h*dy [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! Volume flux through zonal faces = u*h*dy [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZIB_(G),SZK_(G)) :: & - uh_aux, & ! An auxiliary zonal volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - duhdu ! Partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_aux, & ! An auxiliary zonal volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. + duhdu ! Partial derivative of uh with u [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)) :: & - uh_err, & ! Difference between uhbt and the summed uh [H m2 s-1 ~> m3 s-1 or kg s-1]. - uh_err_best, & ! The smallest value of uh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. - u_new, & ! The velocity with the correction added [m s-1]. - duhdu_tot,&! Summed partial derivative of uh with u [H m ~> m2 or kg m-1]. + uh_err, & ! Difference between uhbt and the summed uh [H L2 T-1 ~> m3 s-1 or kg s-1]. + uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. + u_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + duhdu_tot,&! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. du_min, & ! Min/max limits on du correction based on CFL limits - du_max ! and previous iterations [m s-1]. - real :: du_prev ! The previous value of du [m s-1]. - real :: ddu ! The change in du from the previous iteration [m s-1]. + du_max ! and previous iterations [L T-1 ~> m s-1]. + real :: du_prev ! The previous value of du [L T-1 ~> m s-1]. + real :: ddu ! The change in du from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZIB_(G)) @@ -815,8 +779,8 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & enddo domore = .false. do I=ish-1,ieh ; if (do_I(I)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or.& + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i+1,j))*abs(uh_err(I)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(uh_err(I)) > tol_vel * duhdu_tot(I)) .or. & (abs(uh_err(I)) > uh_err_best(I))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -854,7 +818,7 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & do I=ish-1,ieh ; u_new(I) = u(I,j,k) + du(I) * visc_rem(I,k) ; enddo call zonal_flux_layer(u_new, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), & uh_aux(:,k), duhdu(:,k), visc_rem(:,k), & - dt, G, j, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -883,10 +847,10 @@ end subroutine zonal_flux_adjust !> Sets a structure that describes the zonal barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, & - du_max_CFL, du_min_CFL, dt, G, CS, visc_rem, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the @@ -896,14 +860,15 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZIB_(G)), intent(in) :: uh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(in) :: duhdu_tot_0 !< The partial derivative - !! of du_err with du at 0 adjustment [H m ~> m2 or kg m-1]. + !! of du_err with du at 0 adjustment [H L ~> m2 or kg m-1]. real, dimension(SZIB_(G)), intent(in) :: du_max_CFL !< Maximum acceptable - !! value of du [m s-1]. + !! value of du [L T-1 ~> m s-1]. real, dimension(SZIB_(G)), intent(in) :: du_min_CFL !< Minimum acceptable - !! value of du [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! value of du [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZIB_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step of viscosity, and @@ -918,24 +883,24 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, !! which I values to work on. ! Local variables real, dimension(SZIB_(G)) :: & - du0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. duL, duR, & ! The barotropic velocity increments that give the westerly - ! (duL) and easterly (duR) test velocities. + ! (duL) and easterly (duR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - du_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + du_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic - u_0, & ! transport (u_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the westerly - FA_marg_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + u_0, & ! transport (u_0) layer test velocities [L T-1 ~> m s-1]. + duhdu_L, & ! The effective layer marginal face areas with the westerly + duhdu_R, & ! (_L), easterly (_R), and zero-barotropic (_0) test + duhdu_0, & ! velocities [H L ~> m2 or kg m-1]. uh_L, uh_R, & ! The layer transports with the westerly (_L), easterly (_R), - uh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + uh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 - FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. + FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and - uhtot_R ! and easterly (uhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [m H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [m H ~> m2 or kg m], nominally given by + uhtot_R ! and easterly (uhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. + real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem @@ -946,18 +911,18 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0 / (dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, du0. do I=ish-1,ieh ; zeros(I) = 0.0 ; enddo - call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, & - duhdu_tot_0, du0, du_max_CFL, du_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + call zonal_flux_adjust(u, h_in, h_L, h_R, zeros, uh_tot_0, duhdu_tot_0, du0, & + du_max_CFL, du_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the westerly- and easterly- fluxes. Choose a sufficiently ! negative velocity correction for the easterly-flux, and a sufficiently @@ -997,19 +962,16 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, u_R(I) = u(I,j,k) + duR(I) * visc_rem(I,k) u_0(I) = u(I,j,k) + du0(I) * visc_rem(I,k) endif ; enddo - call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, & - FA_marg_0, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, & - FA_marg_L, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) - call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, & - FA_marg_R, visc_rem(:,k), dt, G, j, ish, ieh, do_I, & - CS%vol_CFL) + call zonal_flux_layer(u_0, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_0, duhdu_0, & + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + call zonal_flux_layer(u_L, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_L, duhdu_L, & + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) + call zonal_flux_layer(u_R, h_in(:,j,k), h_L(:,j,k), h_R(:,j,k), uh_R, duhdu_R, & + visc_rem(:,k), dt_in_T, G, US, j, ish, ieh, do_I, CS%vol_CFL) do I=ish-1,ieh ; if (do_I(I)) then - FAmt_0(I) = FAmt_0(I) + FA_marg_0(I) - FAmt_L(I) = FAmt_L(I) + FA_marg_L(I) - FAmt_R(I) = FAmt_R(I) + FA_marg_R(I) + FAmt_0(I) = FAmt_0(I) + duhdu_0(I) + FAmt_L(I) = FAmt_L(I) + duhdu_L(I) + FAmt_R(I) = FAmt_R(I) + duhdu_R(I) uhtot_L(I) = uhtot_L(I) + uh_L(I) uhtot_R(I) = uhtot_R(I) + uh_R(I) endif ; enddo @@ -1047,17 +1009,18 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, end subroutine set_zonal_BT_cont !> Calculates the mass or volume fluxes through the meridional faces, and other related quantities. -subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & - visc_rem_v, v_cor, vhbt_aux, v_cor_aux, BT_cont) +subroutine meridional_mass_flux(v, h_in, vh, dt_in_T, G, GV, US, CS, LB, vhbt, OBC, & + visc_rem_v, v_cor, BT_cont) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Volume flux through meridional !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, intent(in) :: dt !< Time increment [s]. - type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(continuity_PPM_CS), pointer :: CS !< This module's control structure.G type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundary condition type !! specifies whether, where, and what open boundary conditions are used. @@ -1068,48 +1031,41 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & !! that a layer experiences after viscosity is applied. Nondimensional between !! 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt !< The summed volume flux through - !< meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: vhbt_aux !< A second set of summed volume fluxes - !! through meridional faces [H m2 s-1 ~> m3 s-1 or kg s-1]. + !< meridional faces [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: v_cor !< The meridional velocitiess (v with a barotropic correction) - !! that give vhbt as the depth-integrated transport [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - optional, intent(out) :: v_cor_aux - !< The meridional velocities (v with a barotropic correction) - !! that give vhbt_aux as the depth-integrated transports [m s-1]. + !! that give vhbt as the depth-integrated transport [L T-1 ~> m s-1]. type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe !! the effective open face areas as a function of barotropic flow. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. + dvhdv ! Partial derivative of vh with v [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & - dv, & ! Corrective barotropic change in the velocity [m s-1]. + dv, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. dv_min_CFL, & ! Min/max limits on dv correction dv_max_CFL, & ! to avoid CFL violations - dvhdv_tot_0, & ! Summed partial derivative of vh with v [H m ~> m2 or kg m-1]. - vh_tot_0, & ! Summed transport with no barotropic correction [H m2 s-1 ~> m3 s-1 or kg s-1]. + dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L ~> m2 or kg m-1]. + vh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem. logical, dimension(SZI_(G)) :: do_I - real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H m ~> m2 or kg m-1]. + real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H L ~> m2 or kg m-1]. real :: FA_v ! A sum of meridional face areas [H m ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(G)) :: & visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. real :: I_vrm ! 1.0 / visc_rem_max, nondim. real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by - ! the time step [s-1]. - real :: I_dt ! 1.0 / dt [s-1]. - real :: dv_lim ! The velocity change that give a relative CFL of 1 [m s-1]. - real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [m]. + ! the time step [T-1 ~> s-1]. + real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. + real :: dv_lim ! The velocity change that give a relative CFL of 1 [L T-1 ~> m s-1]. + real :: dy_N, dy_S ! Effective y-grid spacings to the north and south [L ~> m]. integer :: i, j, k, ish, ieh, jsh, jeh, n, nz - logical :: do_aux, local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: local_specified_BC, use_visc_rem, set_BT_cont, any_simple_OBC logical :: local_Flather_OBC, is_simple, local_open_BC type(OBC_segment_type), pointer :: segment => NULL() - do_aux = (present(vhbt_aux) .and. present(v_cor_aux)) use_visc_rem = present(visc_rem_v) local_specified_BC = .false. ; set_BT_cont = .false. ; local_Flather_OBC = .false. local_open_BC = .false. @@ -1121,8 +1077,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke - CFL_dt = CS%CFL_limit_adjust / dt - I_dt = 1.0 / dt + CFL_dt = CS%CFL_limit_adjust / (dt_in_T) + I_dt = 1.0 / (dt_in_T) if (CS%aggress_adjust) CFL_dt = I_dt call cpu_clock_begin(id_clock_update) @@ -1143,9 +1099,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & call cpu_clock_begin(id_clock_correct) !$OMP parallel do default(none) shared(ish,ieh,jsh,jeh,nz,v,h_in,h_L,h_R,vh,use_visc_rem, & -!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt,do_aux, & -!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,vhbt_aux, & -!$OMP v_cor_aux,BT_cont, local_Flather_OBC ) & +!$OMP visc_rem_v,dt,G,GV,CS,local_specified_BC,OBC,vhbt, & +!$OMP set_BT_cont,CFL_dt,I_dt,v_cor,BT_cont, local_Flather_OBC ) & !$OMP private(do_I,dvhdv,dv,dv_max_CFL,dv_min_CFL,vh_tot_0, & !$OMP dvhdv_tot_0,visc_rem_max,I_vrm,dv_lim,dy_N, & !$OMP is_simple,FAvi,dy_S,any_simple_OBC ) & @@ -1160,7 +1115,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & enddo ; endif call merid_flux_layer(v(:,J,k), h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh(:,J,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) if (local_specified_BC) then do i=ish,ieh if (OBC%segment(OBC%segnum_v(i,J))%specified) & @@ -1172,7 +1127,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & visc_rem_max(i) = 1.0 enddo ; endif - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then ! Set limits on dv that will keep the CFL number between -1 and 1. ! This should be adequate to keep the root bracketed in all cases. do i=ish,ieh @@ -1246,10 +1201,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & dv_min_CFL(i) = min(dv_min_CFL(i),0.0) enddo - ! Up to this point, everything is shared between vhbt and vhbt_aux. - any_simple_OBC = .false. - if (present(vhbt) .or. do_aux .or. set_BT_cont) then + if (present(vhbt) .or. set_BT_cont) then if (local_specified_BC .or. local_Flather_OBC) then ; do i=ish,ieh ! Avoid reconciling barotropic/baroclinic transports if transport is specified is_simple = OBC%segment(OBC%segnum_v(i,J))%specified @@ -1261,9 +1214,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & endif if (present(vhbt)) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true., vh, OBC=OBC) + call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt(:,J), vh_tot_0, dvhdv_tot_0, dv, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true., vh, OBC=OBC) if (present(v_cor)) then ; do k=1,nz do i=ish,ieh ; v_cor(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo @@ -1274,23 +1227,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & enddo ; endif ! v-corrected endif - if (do_aux) then - call meridional_flux_adjust(v, h_in, h_L, h_R, vhbt_aux(:,J), vh_tot_0, & - dvhdv_tot_0, dv, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .false., OBC=OBC) - - do k=1,nz - do i=ish,ieh ; v_cor_aux(i,J,k) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo - if (local_specified_BC) then ; do i=ish,ieh - if (OBC%segment(OBC%segnum_v(i,J))%specified) & - v_cor_aux(i,J,k) = OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) - enddo ; endif - enddo - endif ! do_aux - if (set_BT_cont) then call set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0,& - dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, J, ish, ieh, do_I) if (any_simple_OBC) then do i=ish,ieh @@ -1300,9 +1239,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & do k=1,nz ; do i=ish,ieh ; if (do_I(i)) then if ((abs(OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k)) > 0.0) .and. & (OBC%segment(OBC%segnum_v(i,J))%specified)) & - FAvi(i) = FAvi(i) + & - OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & - OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) + FAvi(i) = FAvi(i) + OBC%segment(OBC%segnum_v(i,J))%normal_trans(i,J,k) / & + OBC%segment(OBC%segnum_v(i,J))%normal_vel(i,J,k) endif ; enddo ; enddo do i=ish,ieh ; if (do_I(i)) then BT_cont%FA_v_S0(i,J) = FAvi(i) ; BT_cont%FA_v_N0(i,J) = FAvi(i) @@ -1312,7 +1250,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & endif endif ! set_BT_cont - endif ! present(vhbt) or do_aux or set_BT_cont + endif ! present(vhbt) or set_BT_cont + enddo ! j-loop if (local_open_BC .and. set_BT_cont) then @@ -1323,16 +1262,16 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 do k=1,nz ; FA_v = FA_v + h_in(i,j,k)*G%dx_Cv(i,J) ; enddo - BT_cont%Fa_v_S0(i,J) = FA_v ; BT_cont%Fa_v_N0(i,J) = FA_v - BT_cont%Fa_v_SS(i,J) = FA_v ; BT_cont%Fa_v_NN(i,J) = FA_v + BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v + BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 enddo else do i = OBC%segment(n)%HI%Isd, OBC%segment(n)%HI%Ied FA_v = 0.0 do k=1,nz ; FA_v = FA_v + h_in(i,j+1,k)*G%dx_Cv(i,J) ; enddo - BT_cont%Fa_v_S0(i,J) = FA_v ; BT_cont%Fa_v_N0(i,J) = FA_v - BT_cont%Fa_v_SS(i,J) = FA_v ; BT_cont%Fa_v_NN(i,J) = FA_v + BT_cont%FA_v_S0(i,J) = FA_v ; BT_cont%FA_v_N0(i,J) = FA_v + BT_cont%FA_v_SS(i,J) = FA_v ; BT_cont%FA_v_NN(i,J) = FA_v BT_cont%vBT_SS(i,J) = 0.0 ; BT_cont%vBT_NN(i,J) = 0.0 enddo endif @@ -1343,10 +1282,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & if (set_BT_cont) then ; if (allocated(BT_cont%h_v)) then if (present(v_cor)) then - call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v_cor, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) else - call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt, G, LB, & + call merid_face_thickness(v, h_in, h_L, h_R, BT_cont%h_v, dt_in_T, G, US, LB, & CS%vol_CFL, CS%marginal_faces, visc_rem_v, OBC) endif endif ; endif @@ -1354,10 +1293,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & end subroutine meridional_mass_flux !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & +subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt_in_T, G, US, J, & ish, ieh, do_I, vol_CFL, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step !! of viscosity, and the fraction of a time-step's worth of a barotropic @@ -1370,10 +1309,11 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_R !< Right thickness in the reconstruction !! [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: vh !< Meridional mass or volume transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(inout) :: dvhdv !< Partial derivative of vh with v - !! [H m ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [s]. + !! [H L ~> m2 or kg m-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. integer, intent(in) :: ieh !< End of index range. @@ -1396,16 +1336,16 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & do i=ish,ieh ; if (do_I(i)) then if (v(i) > 0.0) then - if (vol_CFL) then ; CFL = (v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j) + h_R(i,j) - 2.0*h(i,j) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_R(i,j) + CFL * & (0.5*(h_L(i,j) - h_R(i,j)) + curv_3*(CFL - 1.5)) ) h_marg = h_R(i,j) + CFL * ((h_L(i,j) - h_R(i,j)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1) + h_R(i,j+1) - 2.0*h(i,j+1) vh(i) = G%dx_Cv(i,J) * v(i) * ( h_L(i,j+1) + CFL * & (0.5*(h_R(i,j+1)-h_L(i,j+1)) + curv_3*(CFL - 1.5)) ) @@ -1434,10 +1374,10 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, J, & end subroutine merid_flux_layer !> Sets the effective interface thickness at each meridional velocity point. -subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & +subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt_in_T, G, US, LB, vol_CFL, & marginal, visc_rem_v, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1446,8 +1386,9 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: h_v !< Thickness at meridional faces, !! [H ~> m or kg m-2]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: vol_CFL !< If true, rescale the ratio !! of face areas to the cell areas when estimating the CFL number. logical, intent(in) :: marginal !< If true, report the marginal @@ -1462,7 +1403,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. + ! with the same units as h [H ~> m or kg m-2] . real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC @@ -1472,15 +1413,15 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, LB, vol_CFL, & !$OMP parallel do default(shared) private(CFL,curv_3,h_marg,h_avg) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh if (v(i,J,k) > 0.0) then - if (vol_CFL) then ; CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) - else ; CFL = v(i,J,k) * dt * G%IdyT(i,j) ; endif + if (vol_CFL) then ; CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + else ; CFL = v(i,J,k) * dt_in_T * G%IdyT(i,j) ; endif curv_3 = h_L(i,j,k) + h_R(i,j,k) - 2.0*h(i,j,k) h_avg = h_R(i,j,k) + CFL * (0.5*(h_L(i,j,k) - h_R(i,j,k)) + curv_3*(CFL - 1.5)) h_marg = h_R(i,j,k) + CFL * ((h_L(i,j,k) - h_R(i,j,k)) + & 3.0*curv_3*(CFL - 1.0)) elseif (v(i,J,k) < 0.0) then - if (vol_CFL) then ; CFL = (-v(i,J,k)*dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) - else ; CFL = -v(i,J,k) * dt * G%IdyT(i,j+1) ; endif + if (vol_CFL) then ; CFL = (-v(i,J,k)*dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + else ; CFL = -v(i,J,k) * dt_in_T * G%IdyT(i,j+1) ; endif curv_3 = h_L(i,j+1,k) + h_R(i,j+1,k) - 2.0*h(i,j+1,k) h_avg = h_L(i,j+1,k) + CFL * (0.5*(h_R(i,j+1,k)-h_L(i,j+1,k)) + curv_3*(CFL - 1.5)) h_marg = h_L(i,j+1,k) + CFL * ((h_R(i,j+1,k)-h_L(i,j+1,k)) + & @@ -1542,11 +1483,11 @@ end subroutine merid_face_thickness !> Returns the barotropic velocity adjustment that gives the desired barotropic (layer-summed) transport. subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0, & - dv, dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv, dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & j, ish, ieh, do_I_in, full_precision, vh_3d, OBC) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Meridional velocity [m s-1]. + intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_in !< Layer thickness used to calculate fluxes [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& @@ -1561,15 +1502,16 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G)), & optional, intent(in) :: vhbt !< The summed volume flux through meridional faces - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport with 0 adjustment - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative of dv_err with - !! dv at 0 adjustment [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(out) :: dv !< The barotropic velocity adjustment [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -1580,23 +1522,23 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 !! iterate. The default is .true. (more accurate). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(inout) :: vh_3d !< Volume flux through meridional - !! faces = v*h*dx [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1]. type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real, dimension(SZI_(G),SZK_(G)) :: & - vh_aux, & ! An auxiliary meridional volume flux [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vh_aux, & ! An auxiliary meridional volume flux [H L2 s-1 ~> m3 s-1 or kg s-1]. dvhdv ! Partial derivative of vh with v [H m ~> m2 or kg m-1]. real, dimension(SZI_(G)) :: & - vh_err, & ! Difference between vhbt and the summed vh [H m2 s-1 ~> m3 s-1 or kg s-1]. - vh_err_best, & ! The smallest value of vh_err found so far [H m2 s-1 ~> m3 s-1 or kg s-1]. - v_new, & ! The velocity with the correction added [m s-1]. - dvhdv_tot,&! Summed partial derivative of vh with u [H m ~> m2 or kg m-1]. + vh_err, & ! Difference between vhbt and the summed vh [H L2 T-1 ~> m3 s-1 or kg s-1]. + vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. + v_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. + dvhdv_tot,&! Summed partial derivative of vh with u [H L ~> m2 or kg m-1]. dv_min, & ! Min/max limits on dv correction based on CFL limits - dv_max ! and previous iterations [m s-1]. - real :: dv_prev ! The previous value of dv [m s-1]. - real :: ddv ! The change in dv from the previous iteration [m s-1]. + dv_max ! and previous iterations [L T-1 ~> m s-1]. + real :: dv_prev ! The previous value of dv [L T-1 ~> m s-1]. + real :: ddv ! The change in dv from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. - real :: tol_vel ! The tolerance for velocity in the current iteration [m s-1]. + real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 logical :: full_prec, domore, do_I(SZI_(G)) @@ -1636,8 +1578,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 enddo domore = .false. do i=ish,ieh ; if (do_I(i)) then - if ((dt*min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or.& - (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or.& + if ((dt_in_T * min(G%IareaT(i,j),G%IareaT(i,j+1))*abs(vh_err(i)) > tol_eta) .or. & + (CS%better_iter .and. ((abs(vh_err(i)) > tol_vel * dvhdv_tot(i)) .or. & (abs(vh_err(i)) > vh_err_best(i))) )) then ! Use Newton's method, provided it stays bounded. Otherwise bisect ! the value with the appropriate bound. @@ -1675,7 +1617,7 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 do i=ish,ieh ; v_new(i) = v(i,J,k) + dv(i) * visc_rem(i,k) ; enddo call merid_flux_layer(v_new, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), & vh_aux(:,k), dvhdv(:,k), visc_rem(:,k), & - dt, G, J, ish, ieh, do_I, CS%vol_CFL, OBC) + dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL, OBC) enddo ; endif if (itt < max_itts) then @@ -1704,10 +1646,10 @@ end subroutine meridional_flux_adjust !> Sets of a structure that describes the meridional barotropic volume or mass fluxes as a !! function of barotropic flow to agree closely with the sum of the layer's transports. subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, & - dv_max_CFL, dv_min_CFL, dt, G, CS, visc_rem, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & visc_rem_max, j, ish, ieh, do_I) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_L !< Left thickness in the reconstruction, @@ -1717,12 +1659,15 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, type(BT_cont_type), intent(inout) :: BT_cont !< A structure with elements !! that describe the effective open face areas as a function of barotropic flow. real, dimension(SZI_(G)), intent(in) :: vh_tot_0 !< The summed transport - !! with 0 adjustment [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! with 0 adjustment [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G)), intent(in) :: dvhdv_tot_0 !< The partial derivative - !! of du_err with dv at 0 adjustment [H m ~> m2 or kg m-1]. - real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value of dv [m s-1]. - real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value of dv [m s-1]. - real, intent(in) :: dt !< Time increment [s]. + !! of du_err with dv at 0 adjustment [H L ~> m2 or kg m-1]. + real, dimension(SZI_(G)), intent(in) :: dv_max_CFL !< Maximum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, dimension(SZI_(G)), intent(in) :: dv_min_CFL !< Minimum acceptable value + !! of dv [L T-1 ~> m s-1]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), pointer :: CS !< This module's control structure. real, dimension(SZI_(G),SZK_(G)), intent(in) :: visc_rem !< Both the fraction of the !! momentum originally in a layer that remains after a time-step @@ -1737,24 +1682,24 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, !! which I values to work on. ! Local variables real, dimension(SZI_(G)) :: & - dv0, & ! The barotropic velocity increment that gives 0 transport [m s-1]. + dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. dvL, dvR, & ! The barotropic velocity increments that give the southerly - ! (dvL) and northerly (dvR) test velocities. + ! (dvL) and northerly (dvR) test velocities [L T-1 ~> m s-1]. zeros, & ! An array of full of 0's. - dv_CFL, & ! The velocity increment that corresponds to CFL_min [m s-1]. + dv_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic - v_0, & ! transport (v_0) layer test velocities [m s-1]. - FA_marg_L, & ! The effective layer marginal face areas with the southerly - FA_marg_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test - FA_marg_0, & ! velocities [H m ~> m2 or kg m-1]. + v_0, & ! transport (v_0) layer test velocities [L T-1 ~> m s-1]. + dvhdv_L, & ! The effective layer marginal face areas with the southerly + dvhdv_R, & ! (_L), northerly (_R), and zero-barotropic (_0) test + dvhdv_0, & ! velocities [H L ~> m2 or kg m-1]. vh_L, vh_R, & ! The layer transports with the southerly (_L), northerly (_R) - vh_0, & ! and zero-barotropic (_0) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + vh_0, & ! and zero-barotropic (_0) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. FAmt_L, FAmt_R, & ! The summed effective marginal face areas for the 3 FAmt_0, & ! test velocities [H m ~> m2 or kg m-1]. vhtot_L, & ! The summed transport with the southerly (vhtot_L) and - vhtot_R ! and northerly (vhtot_R) test velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [H m ~> m2 or kg m-1]. - real :: FA_avg ! The average effective face area [H m ~> m2 or kg m-1], nominally given by + vhtot_R ! and northerly (vhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: FA_0 ! The effective face area with 0 barotropic transport [H L ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [H L ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim] This ! limiting is necessary to keep the inverse of visc_rem @@ -1765,18 +1710,18 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: domore integer :: i, k, nz - nz = G%ke ; Idt = 1.0/dt + nz = G%ke ; Idt = 1.0/(dt_in_T) min_visc_rem = 0.1 ; CFL_min = 1e-6 ! Diagnose the zero-transport correction, dv0. do i=ish,ieh ; zeros(i) = 0.0 ; enddo - call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, & - dvhdv_tot_0, dv0, dv_max_CFL, dv_min_CFL, dt, G, & - CS, visc_rem, j, ish, ieh, do_I, .true.) + call meridional_flux_adjust(v, h_in, h_L, h_R, zeros, vh_tot_0, dvhdv_tot_0, dv0, & + dv_max_CFL, dv_min_CFL, dt_in_T, G, US, CS, visc_rem, & + j, ish, ieh, do_I, .true.) ! Determine the southerly- and northerly- fluxes. Choose a sufficiently ! negative velocity correction for the northerly-flux, and a sufficiently @@ -1816,19 +1761,16 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, v_R(i) = v(I,j,k) + dvR(i) * visc_rem(i,k) v_0(i) = v(I,j,k) + dv0(i) * visc_rem(i,k) endif ; enddo - call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, & - FA_marg_0, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, & - FA_marg_L, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) - call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, & - FA_marg_R, visc_rem(:,k), dt, G, J, ish, ieh, do_I, & - CS%vol_CFL) + call merid_flux_layer(v_0, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_0, dvhdv_0, & + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + call merid_flux_layer(v_L, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_L, dvhdv_L, & + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) + call merid_flux_layer(v_R, h_in(:,:,k), h_L(:,:,k), h_R(:,:,k), vh_R, dvhdv_R, & + visc_rem(:,k), dt_in_T, G, US, J, ish, ieh, do_I, CS%vol_CFL) do i=ish,ieh ; if (do_I(i)) then - FAmt_0(i) = FAmt_0(i) + FA_marg_0(i) - FAmt_L(i) = FAmt_L(i) + FA_marg_L(i) - FAmt_R(i) = FAmt_R(i) + FA_marg_R(i) + FAmt_0(i) = FAmt_0(i) + dvhdv_0(i) + FAmt_L(i) = FAmt_L(i) + dvhdv_L(i) + FAmt_R(i) = FAmt_R(i) + dvhdv_R(i) vhtot_L(i) = vhtot_L(i) + vh_L(i) vhtot_R(i) = vhtot_R(i) + vh_R(i) endif ; enddo @@ -2235,10 +2177,11 @@ function ratio_max(a, b, maxrat) result(ratio) end function ratio_max !> Initializes continuity_ppm_cs -subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< Time increment [s]. +subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) + type(time_type), target, 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 !< 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 indicating !! the open file to parse for model parameter values. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to @@ -2283,6 +2226,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & default=0.5*G%ke*GV%Angstrom_m, unscaled=tol_eta_m) + !### ETA_TOLERANCE_AUX can be obsoleted. call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies "//& "between the barotropic solution and the sum of the "//& @@ -2293,7 +2237,8 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies "//& "between the barotropic solution and the sum of the "//& - "layer thicknesses.", units="m s-1", default=3.0e8) ! The speed of light is the default. + "layer thicknesses.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) + ! The speed of light is the default. call get_param(param_file, mdl, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& "If true, allow the adjusted velocities to have a "//& diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c6bc7b5c6a..1f43a699a1 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -69,14 +69,14 @@ module MOM_dynamics_split_RK2 !> MOM_dynamics_split_RK2 module control structure type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2] - PFu, & !< PFu = -dM/dx [m s-2] - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2] + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2] - PFv, & !< PFv = -dM/dy [m s-2] - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2] + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u !< Both the fraction of the zonal momentum originally in a @@ -87,7 +87,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt !< The zonal layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: visc_rem_v !< Both the fraction of the meridional momentum originally in !! a layer that remains after a time-step of viscosity, and the @@ -97,7 +97,7 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt !< The meridional layer accelerations due to the difference between !! the barotropic accelerations and the baroclinic accelerations - !! that were fed into the barotopic calculation [m s-2] + !! that were fed into the barotopic calculation [L T-2 ~> m s-2] ! The following variables are only used with the split time stepping scheme. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq @@ -105,26 +105,28 @@ module MOM_dynamics_split_RK2 !! mode) [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by !! time-mean barotropic velocity over a baroclinic - !! timestep [m s-1] + !! timestep [L T-1 ~> m s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer !! thicknesses [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and !! PFv [H ~> m or kg m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! uhbt is roughly equal to the vertical sum of uh. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the - !! barotropic solver [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! barotropic solver [H L2 T-1 ~> m3 s-1 or kg s-1]. !! vhbt is roughly equal to vertical sum of vh. real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height - !! anomalies [m2 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor [Pa] - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor [Pa] + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the !! effective summed open face areas as a function !! of barotropic flow. @@ -238,9 +240,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & 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),SZJ_(G),SZK_(G)), & - target, intent(inout) :: u !< zonal velocity [m s-1] + target, intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: v !< merid velocity [m s-1] + target, intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type @@ -254,16 +256,16 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! time step [Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & target, intent(inout) :: uh !< zonal volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & target, intent(inout) :: vh !< merid volume/mass transport - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(inout) :: uhtr !< accumulatated zonal volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(inout) :: vhtr !< accumulatated merid volume/mass transport - !! since last tracer advection [H m2 ~> m3 or kg] + !! since last tracer advection [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time !! averaged over time step [H ~> m or kg m-2] type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure @@ -276,21 +278,19 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !! fields related to the surface wave conditions ! local variables - real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: hp ! Predicted thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_bc_accel real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_bc_accel ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [m s-2]. + ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: uh_in real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: vh_in ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G)) :: uhbt_out real, dimension(SZI_(G),SZJB_(G)) :: vhbt_out @@ -301,16 +301,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! eta_pred is the predictor value of the free surface height or column mass, ! [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target :: u_adj - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target :: v_adj - ! u_adj and v_adj are the zonal or meridional velocities after u and v - ! have been barotropically adjusted so the resulting transports match - ! uhbt_out and vhbt_out [m s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u_old_rad_OBC real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v_old_rad_OBC ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [m s-1]. + ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. real :: Pa_to_eta ! A factor that converts pressures to the units of eta. real, pointer, dimension(:,:) :: & @@ -320,11 +314,13 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & real, pointer, dimension(:,:,:) :: & uh_ptr => NULL(), u_ptr => NULL(), vh_ptr => NULL(), v_ptr => NULL(), & - u_init => NULL(), v_init => NULL(), & ! Pointers to u and v or u_adj and v_adj. - u_av, & ! The zonal velocity time-averaged over a time step [m s-1]. - v_av, & ! The meridional velocity time-averaged over a time step [m s-1]. + u_av, & ! The zonal velocity time-averaged over a time step [L T-1 ~> m s-1]. + 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 :: Idt + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. + + real :: Idt ! The inverse of the timestep [s-1] logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the ! relative weightings of the layers in calculating @@ -337,6 +333,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta + + dt_in_T = US%s_to_T*dt Idt = 1.0 / dt sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums @@ -345,7 +343,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") !$OMP parallel do default(shared) - do k = 1, nz + do k=1,nz do j=G%jsd,G%jed ; do i=G%isdB,G%iedB ; up(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsdB,G%jedB ; do i=G%isd,G%ied ; vp(i,j,k) = 0.0 ; enddo ; enddo do j=G%jsd,G%jed ; do i=G%isd,G%ied ; hp(i,j,k) = h(i,j,k) ; enddo ; enddo @@ -355,7 +353,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) if (CS%debug) then - call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call check_redundant("Start predictor u ", u, v, G) call check_redundant("Start predictor uh ", uh, vh, G) endif @@ -449,10 +447,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%Cau(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%Cav(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -462,7 +460,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call MOM_accel_chksum("pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, u_bc_accel, v_bc_accel, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) call check_redundant("pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) @@ -474,10 +472,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * u_bc_accel(I,j,k)) + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * u_bc_accel(I,j,k)) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * v_bc_accel(i,J,k)) + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * v_bc_accel(i,J,k)) enddo ; enddo enddo @@ -490,7 +488,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, CS%vertvisc_CSp) + 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)") @@ -518,9 +516,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_accel_bt = layer accelerations due to barotropic solver if (associated(CS%BT_cont) .or. CS%BT_use_layer_fluxes) then call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh_in, vh_in, dt, G, GV, & - CS%continuity_CSp, OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, & - visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) + call continuity(u, v, h, hp, uh_in, vh_in, dt_in_T, G, GV, US, CS%continuity_CSp, & + OBC=CS%OBC, visc_rem_u=CS%visc_rem_u, visc_rem_v=CS%visc_rem_v, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) if (BT_cont_BT_thick) then call btcalc(h, G, GV, CS%barotropic_CSp, CS%BT_cont%h_u, CS%BT_cont%h_v, & @@ -530,10 +527,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%BT_use_layer_fluxes) then - uh_ptr => uh_in; vh_ptr => vh_in; u_ptr => u; v_ptr => v + uh_ptr => uh_in ; vh_ptr => vh_in; u_ptr => u ; v_ptr => v endif - u_init => u ; v_init => v call cpu_clock_begin(id_clock_btstep) if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") @@ -548,31 +544,31 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_end(id_clock_btstep) ! up = u + dt_pred*( u_bc_accel + u_accel_bt ) - dt_pred = dt * CS%be + dt_pred = dt_in_T * CS%be call cpu_clock_begin(id_clock_mom_update) !$OMP parallel do default(shared) do k=1,nz do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt_pred * & + vp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_pred * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt_pred * & + up(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_pred * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym) + call uvchksum("Predictor 1 [uv]", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Predictor 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & - symmetric=sym, scale=GV%H_to_m) -! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) +! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u_init, v_init, h, uh, vh, G, GV, haloshift=2, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) + call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & symmetric=sym) call check_redundant("Predictor 1 up", up, vp, G) call check_redundant("Predictor 1 uh", uh, vh, G) @@ -582,11 +578,11 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! u_av <- u_av + dt_pred d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) if (CS%debug) then - call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym) + call uvchksum("0 before vertvisc: [uv]p", 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_pred, G, GV, US, CS%vertvisc_CSp, & + call vertvisc_coef(up, vp, h, forces, visc, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + call vertvisc(up, vp, h, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then @@ -594,7 +590,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, US%T_to_s*dt_pred, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) @@ -607,7 +603,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! uh = u_av * h ! hp = h + dt * div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h, hp, uh, vh, dt, G, GV, CS%continuity_CSp, & + call continuity(up, vp, h, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, & u_av, v_av, BT_cont=CS%BT_cont) call cpu_clock_end(id_clock_continuity) @@ -618,12 +614,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then if (CS%debug) & - call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Pre OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) - call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, dt_pred) + call radiation_open_bdry_conds(CS%OBC, u_av, u_old_rad_OBC, v_av, v_old_rad_OBC, G, US, US%T_to_s*dt_pred) if (CS%debug) & - call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) + call uvchksum("Post OBC avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) ! These should be done with a pass that excludes uh & vh. ! call do_group_pass(CS%pass_hp_uv, G%Domain, clock=id_clock_pass) @@ -678,10 +674,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (CS%debug) then - call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, symmetric=sym) + call MOM_state_chksum("Predictor ", up, vp, hp, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) - ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) call check_redundant("Predictor up ", up, vp, G) call check_redundant("Predictor uh ", uh, vh, G) endif @@ -721,7 +717,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%debug) then call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, u_bc_accel, v_bc_accel, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) call check_redundant("corr pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) @@ -746,6 +742,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & taux_bot=taux_bot, tauy_bot=tauy_bot, & uh0=uh_ptr, vh0=vh_ptr, u_uh0=u_ptr, v_vh0=v_ptr) do j=js,je ; do i=is,ie ; eta(i,j) = eta_pred(i,j) ; enddo ; enddo + call cpu_clock_end(id_clock_btstep) if (showCallTree) call callTree_leave("btstep()") @@ -758,24 +755,24 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u_init(I,j,k) + dt * & + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & (u_bc_accel(I,j,k) + CS%u_accel_bt(I,j,k))) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v_init(i,J,k) + dt * & + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & (v_bc_accel(i,J,k) + CS%v_accel_bt(i,J,k))) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym) + call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & - symmetric=sym, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, haloshift=1) + symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & + CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, & symmetric=sym) endif @@ -790,7 +787,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, CS%vertvisc_CSp) + 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 (step_MOM_dyn_split_RK2)") @@ -811,9 +808,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! h = h + dt * div . uh ! u_av and v_av adjusted so their mass transports match uhbt and vhbt. call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, h, uh, vh, dt, G, GV, & - CS%continuity_CSp, CS%uhbt, CS%vhbt, CS%OBC, & - CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) + call continuity(u, v, h, h, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, & + CS%uhbt, CS%vhbt, CS%OBC, CS%visc_rem_u, CS%visc_rem_v, u_av, v_av) call cpu_clock_end(id_clock_continuity) call do_group_pass(CS%pass_h, G%Domain, clock=id_clock_pass) ! Whenever thickness changes let the diag manager know, target grids @@ -828,7 +824,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif if (associated(CS%OBC)) then - call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, dt) + call radiation_open_bdry_conds(CS%OBC, u, u_old_rad_OBC, v, v_old_rad_OBC, G, US, dt) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -843,10 +839,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & !$OMP parallel do default(shared) do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uh(I,j,k)*dt_in_T enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vh(i,J,k)*dt_in_T enddo ; enddo enddo @@ -869,10 +865,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (CS%id_v_BT_accel > 0) call post_data(CS%id_v_BT_accel, CS%v_accel_bt, CS%diag) if (CS%debug) then - call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, symmetric=sym) - call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI,haloshift=1, symmetric=sym) + call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym, vel_scale=1.0) + call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h_av, "Corrector avg h", G%HI, haloshift=1, scale=GV%H_to_m) - ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV) + ! call MOM_state_chksum("Corrector avg ", u_av, v_av, h_av, uh, vh, G, GV, US) endif if (showCallTree) call callTree_leave("step_MOM_dyn_split_RK2()") @@ -889,9 +885,9 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -968,14 +964,14 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 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),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< zonal velocity [m s-1] + intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< merid velocity [m s-1] + intent(inout) :: v !< merid velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - target, intent(inout) :: uh !< zonal volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: uh !< zonal volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - target, intent(inout) :: vh !< merid volume/mass transport [H m2 s-1 ~> m3 s-1 or kg s-1] + target, intent(inout) :: vh !< merid volume/mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< current model time type(param_file_type), intent(in) :: param_file !< parameter file for parsing @@ -1011,8 +1007,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param character(len=48) :: thickness_units, flux_units, eta_rest_name real :: H_rescale ! A rescaling factor for thicknesses from the representation in ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. real :: uH_rescale ! A rescaling factor for thickness transports from the representation in ! a restart file to the internal representation in this run. + real :: accel_rescale ! A rescaling factor for accelerations from the representation in + ! a restart file to the internal representation in this run. real :: H_convert type(group_pass_type) :: pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1105,12 +1105,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt ! Accel_diag%u_av => CS%u_av ; Accel_diag%v_av => CS%v_av - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -1148,23 +1148,43 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%tides_CSp) if (.not. query_initialized(CS%diffu,"diffu",restart_CS) .or. & - .not. query_initialized(CS%diffv,"diffv",restart_CS)) & + .not. query_initialized(CS%diffv,"diffv",restart_CS)) then call horizontal_viscosity(u, v, h, CS%diffu, CS%diffv, MEKE, VarMix, & G, GV, US, CS%hor_visc_CSp, & OBC=CS%OBC, BT=CS%barotropic_CSp) + else + if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%m_to_L * US%s_to_T_restart**2 /= US%m_to_L_restart * US%s_to_T**2) ) then + accel_rescale = (US%m_to_L * US%s_to_T_restart**2) / (US%m_to_L_restart * US%s_to_T**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB + CS%diffu(I,j,k) = accel_rescale * CS%diffu(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie + CS%diffv(i,J,k) = accel_rescale * CS%diffv(i,J,k) + enddo ; enddo ; enddo + endif + endif + if (.not. query_initialized(CS%u_av,"u2", restart_CS) .or. & .not. query_initialized(CS%u_av,"v2", restart_CS)) then - CS%u_av(:,:,:) = u(:,:,:) - CS%v_av(:,:,:) = v(:,:,:) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB ; CS%u_av(I,j,k) = u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = v(i,J,k) ; enddo ; enddo ; enddo + elseif ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then + vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; CS%u_av(I,j,k) = vel_rescale * CS%u_av(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif ! This call is just here to initialize uh and vh. if (.not. query_initialized(uh,"uh",restart_CS) .or. & .not. query_initialized(vh,"vh",restart_CS)) then - h_tmp(:,:,:) = h(:,:,:) - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, CS%continuity_CSp, OBC=CS%OBC) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo + call continuity(u, v, h, h_tmp, uh, vh, US%s_to_T*dt, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) - CS%h_av(:,:,:) = 0.5*(h(:,:,:) + h_tmp(:,:,:)) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) + enddo ; enddo ; enddo else if (.not. query_initialized(CS%h_av,"h2",restart_CS)) then CS%h_av(:,:,:) = h(:,:,:) @@ -1172,8 +1192,11 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo endif - if ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= GV%m_to_H)) then - uH_rescale = GV%m_to_H / GV%m_to_H_restart + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) /= & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T)) ) then + uH_rescale = (GV%m_to_H * US%m_to_L**2 * US%s_to_T_restart) / & + (GV%m_to_H_restart * US%m_to_L_restart**2 * US%s_to_T) do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo endif @@ -1190,29 +1213,29 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'm s-2') + 'Zonal Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'm s-2') + 'Meridional Coriolis and Advective Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'm s-2') + 'Zonal Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'm s-2') + 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_uav = register_diag_field('ocean_model', 'uav', diag%axesCuL, Time, & - 'Barotropic-step Averaged Zonal Velocity', 'm s-1') + 'Barotropic-step Averaged Zonal Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_vav = register_diag_field('ocean_model', 'vav', diag%axesCvL, Time, & - 'Barotropic-step Averaged Meridional Velocity', 'm s-1') + 'Barotropic-step Averaged Meridional Velocity', 'm s-1', conversion=US%L_T_to_m_s) CS%id_u_BT_accel = register_diag_field('ocean_model', 'u_BT_accel', diag%axesCuL, Time, & - 'Barotropic Anomaly Zonal Acceleration', 'm s-1') + 'Barotropic Anomaly Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_v_BT_accel = register_diag_field('ocean_model', 'v_BT_accel', diag%axesCvL, Time, & - 'Barotropic Anomaly Meridional Acceleration', 'm s-1') + 'Barotropic Anomaly Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index dd03e11f42..108f4c8943 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -107,17 +107,19 @@ module MOM_dynamics_unsplit !> MOM_dynamics_unsplit module control structure type, public :: MOM_dyn_unsplit_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -187,8 +189,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), 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. @@ -203,13 +205,13 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the surface !! pressure at the end of this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume or mass - !! transport since the last tracer advection [H m2 ~> m3 or kg]. + !! transport since the last tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or !! column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by @@ -222,17 +224,18 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! fields related to the surface wave conditions ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp ! Prediced or averaged layer thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up, upp ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp, vpp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() - real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + real :: dt_in_T ! The dynamics time step [T ~> s] + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_pred = dt / 3.0 + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T / 3.0 h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 @@ -249,7 +252,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Start First Predictor ", u, v, h, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -263,8 +266,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = u*h ! hp = h + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(u, v, h, hp, uh, vh, dt*0.5, G, GV, CS%continuity_CSp, & - OBC=CS%OBC) + call continuity(u, v, h, hp, uh, vh, dt_in_T*0.5, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -283,16 +285,16 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = (h(i,j,k) + hp(i,j,k)) * 0.5 enddo ; enddo do j=js,je ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + dt * CS%diffu(I,j,k) * G%mask2dCu(I,j) + u(I,j,k) = u(I,j,k) + dt_in_T * CS%diffu(I,j,k) * G%mask2dCu(I,j) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = v(i,J,k) + dt * CS%diffv(i,J,k) * G%mask2dCv(i,J) + v(i,J,k) = v(i,J,k) + dt_in_T * CS%diffv(i,J,k) * G%mask2dCv(i,J) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo call cpu_clock_end(id_clock_mom_update) @@ -334,9 +336,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif ! up <- up + dt/2 d/dz visc d/dz up @@ -345,6 +347,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call set_viscous_ML(u, v, h_av, tv, forces, visc, dt*0.5, G, GV, US, & CS%set_visc_CSp) call disable_averaging(CS%diag) + !### I think that the time steps in the next two calls should be dt_pred. call vertvisc_coef(up, vp, h_av, forces, visc, dt*0.5, G, GV, US, & CS%vertvisc_CSp, CS%OBC) call vertvisc(up, vp, h_av, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & @@ -355,8 +358,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = up * hp ! h_av = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, hp, h_av, uh, vh, & - (0.5*dt), G, GV, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, hp, h_av, uh, vh, (0.5*dt_in_T), G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_av, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -392,19 +395,19 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp = u + dt/2 * ( PFu + CAu ) call cpu_clock_begin(id_clock_mom_update) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * 0.5 * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + upp(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * 0.5 * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * 0.5 * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + vpp(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * 0.5 * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 2", upp, vpp, h_av, uh, vh, G, GV, US) call MOM_accel_chksum("Predictor 2 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif ! upp <- upp + dt/2 d/dz visc d/dz upp @@ -419,8 +422,8 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! uh = upp * hp ! h = hp + dt/2 div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(upp, vpp, hp, h, uh, vh, & - (dt*0.5), G, GV, CS%continuity_CSp, OBC=CS%OBC) + call continuity(upp, vpp, hp, h, uh, vh, (dt_in_T*0.5), G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -441,10 +444,10 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(i,j,k) = 0.5*(h(i,j,k) + hp(i,j,k)) enddo ; enddo do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt*uh(i,j,k) + uhtr(i,j,k) = uhtr(i,j,k) + 0.5*dt_in_T*uh(i,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt*vh(i,j,k) + vhtr(i,j,k) = vhtr(i,j,k) + 0.5*dt_in_T*vh(i,j,k) enddo ; enddo enddo @@ -470,12 +473,12 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call open_boundary_zero_normal_flow(CS%OBC, G, CS%CAu, CS%CAv) endif do k=1,nz ; do j=js,je ; do I=Isq,Ieq - u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt * & - (CS%PFu(I,j,k) + CS%CAu(I,j,k))) + u(I,j,k) = G%mask2dCu(I,j) * (u(I,j,k) + dt_in_T * & + (CS%PFu(I,j,k) + CS%CAu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt * & - (CS%PFv(i,J,k) + CS%CAv(i,J,k))) + v(i,J,k) = G%mask2dCv(i,J) * (v(i,J,k) + dt_in_T * & + (CS%PFv(i,J,k) + CS%CAv(i,J,k))) enddo ; enddo ; enddo ! u <- u + dt d/dz visc d/dz u @@ -487,9 +490,9 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call pass_vector(u, v, G%Domain, clock=id_clock_pass) if (CS%debug) then - call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u, v, h, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif if (GV%Boussinesq) then @@ -559,16 +562,16 @@ end subroutine register_restarts_dyn_unsplit !> Initialize parameters and allocate memory associated with the unsplit dynamics module. subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(inout) :: u !< The zonal velocity [m s-1]. + intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(inout) :: v !< The meridional velocity [m s-1]. + intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. @@ -589,6 +592,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. + type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions are !! used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. @@ -649,12 +653,12 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -669,18 +673,18 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2, conversion=US%L_T2_to_m_s2') CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'meter second-2') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index b5b547b362..af33db8011 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -26,7 +26,7 @@ module MOM_dynamics_unsplit_RK2 !* The subroutine step_MOM_dyn_unsplit_RK2 actually does the time * !* stepping, while register_restarts_dyn_unsplit_RK2 sets the fields * !* that are found in a full restart file with this scheme, and * -!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * * +!* initialize_dyn_unsplit_RK2 initializes the cpu clocks that are * !* used in this module. For largely historical reasons, this module * !* does not have its own control structure, but shares the same * !* control structure with MOM.F90 and the other MOM_dynamics_... * @@ -104,17 +104,19 @@ module MOM_dynamics_unsplit_RK2 !> MOM_dynamics_unsplit_RK2 module control structure type, public :: MOM_dyn_unsplit_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - CAu, & !< CAu = f*v - u.grad(u) [m s-2]. - PFu, & !< PFu = -dM/dx [m s-2]. - diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]. + PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]. + diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - CAv, & !< CAv = -f*u - u.grad(v) [m s-2]. - PFv, & !< PFv = -dM/dy [m s-2]. - diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [m s-2]. + CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]. + PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]. + diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]. - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean + !! to the seafloor [kg L Z T-2 m-3 ~> Pa] real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme. @@ -191,9 +193,9 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in !< The input and output zonal - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in !< The input and output meridional - !! velocity [m s-1]. + !! velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in !< The input and output layer thicknesses, !! [H ~> m or kg m-2], depending on whether !! the Boussinesq approximation is made. @@ -213,15 +215,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! the surface pressure at the end of !! this dynamic step [Pa]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh !< The zonal volume or mass transport - !! [H m2 s-1 ~> m3 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh !< The meridional volume or mass - !! transport [H m2 s-1 ~> m3 or kg s-1]. + !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< The accumulated zonal volume or !! mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< The accumulated meridional volume !! or mass transport since the last - !! tracer advection [H m2 ~> m3 or kg]. + !! tracer advection [H L2 ~> m3 or kg]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height !! or column mass [H ~> m or kg m-2]. type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by @@ -234,16 +236,18 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, !! Eddy Kinetic Energy. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_av, hp - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: up ! Predicted zonal velocities [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vp ! Predicted meridional velocities [L T-1 ~> m s-1] real, dimension(:,:), pointer :: p_surf => NULL() + real :: dt_in_T ! The dynamics time step [T ~> s] real :: dt_pred ! The time step for the predictor part of the baroclinic - ! time stepping. + ! time stepping [T ~> s]. logical :: dyn_p_surf integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - dt_pred = dt * CS%BE + dt_in_T = US%s_to_T*dt + dt_pred = dt_in_T * CS%BE h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 @@ -260,7 +264,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! all of the fields except h. h is stepped separately. if (CS%debug) then - call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Start Predictor ", u_in, v_in, h_in, uh, vh, G, GV, US) endif ! diffu = horizontal viscosity terms (u,h) @@ -279,8 +283,8 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call cpu_clock_begin(id_clock_continuity) ! This is a duplicate calculation of the last continuity from the previous step ! and could/should be optimized out. -AJA - call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, CS%continuity_CSp, & - OBC=CS%OBC) + call continuity(u_in, v_in, h_in, hp, uh, vh, dt_pred, G, GV, US, & + CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -333,17 +337,17 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, if (CS%debug) & call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) - call set_viscous_ML(up, vp, h_av, tv, forces, visc, dt_pred, G, GV, US, & + call set_viscous_ML(up, vp, h_av, tv, forces, visc, US%T_to_s*dt_pred, 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, & + call vertvisc_coef(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, G, GV, US, & CS%vertvisc_CSp, CS%OBC) - call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & + call vertvisc(up, vp, h_av, forces, visc, US%T_to_s*dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call pass_vector(up, vp, G%Domain, clock=id_clock_pass) @@ -351,8 +355,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n-1/2] * h[n-1/2] ! h_av = h + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, hp, uh, vh, & - dt, G, GV, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, hp, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(hp, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -363,7 +366,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, enddo ; enddo ; enddo if (CS%debug) & - call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV) + call MOM_state_chksum("Predictor 1", up, vp, h_av, uh, vh, G, GV, US) ! CAu = -(f+zeta(up))/h_av vh + d/dx KE(up) (function of up[n-1/2], h[n-1/2]) call cpu_clock_begin(id_clock_Cor) @@ -379,15 +382,15 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up* = u[n] + (1+gamma) * dt * ( PFu + CAu ) Extrapolated for damping ! u*[n+1] = u[n] + dt * ( PFu + CAu ) do k=1,nz ; do j=js,je ; do I=Isq,Ieq - up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * (1.+CS%begw) * & + up(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * (1.+CS%begw) * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) - u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt * & + u_in(I,j,k) = G%mask2dCu(I,j) * (u_in(I,j,k) + dt_in_T * & ((CS%PFu(I,j,k) + CS%CAu(I,j,k)) + CS%diffu(I,j,k))) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * (1.+CS%begw) * & + vp(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * (1.+CS%begw) * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) - v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt * & + v_in(i,J,k) = G%mask2dCv(i,J) * (v_in(i,J,k) + dt_in_T * & ((CS%PFv(i,J,k) + CS%CAv(i,J,k)) + CS%diffv(i,J,k))) enddo ; enddo ; enddo @@ -409,8 +412,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! uh = up[n] * h[n] (up[n] might be extrapolated to damp GWs) ! h[n+1] = h[n] + dt div . uh call cpu_clock_begin(id_clock_continuity) - call continuity(up, vp, h_in, h_in, uh, vh, & - dt, G, GV, CS%continuity_CSp, OBC=CS%OBC) + call continuity(up, vp, h_in, h_in, uh, vh, dt_in_T, G, GV, US, CS%continuity_CSp, OBC=CS%OBC) call cpu_clock_end(id_clock_continuity) call pass_var(h_in, G%Domain, clock=id_clock_pass) call pass_vector(uh, vh, G%Domain, clock=id_clock_pass) @@ -418,17 +420,17 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Accumulate mass flux for tracer transport do k=1,nz do j=js-2,je+2 ; do I=Isq-2,Ieq+2 - uhtr(I,j,k) = uhtr(I,j,k) + dt*uh(I,j,k) + uhtr(I,j,k) = uhtr(I,j,k) + dt_in_T*uh(I,j,k) enddo ; enddo do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 - vhtr(i,J,k) = vhtr(i,J,k) + dt*vh(i,J,k) + vhtr(i,J,k) = vhtr(i,J,k) + dt_in_T*vh(i,J,k) enddo ; enddo enddo if (CS%debug) then - call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV) + call MOM_state_chksum("Corrector", u_in, v_in, h_in, uh, vh, G, GV, US) call MOM_accel_chksum("Corrector accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & - CS%diffu, CS%diffv, G, GV) + CS%diffu, CS%diffv, G, GV, US) endif if (GV%Boussinesq) then @@ -505,14 +507,14 @@ end subroutine register_restarts_dyn_unsplit_RK2 !> Initialize parameters and allocate memory associated with the unsplit RK2 dynamics module. subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag, CS, & - restart_CS, Accel_diag, Cont_diag, MIS, & + restart_CS, Accel_diag, Cont_diag, MIS, MEKE, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(time_type), target, intent(in) :: Time !< The current model time. type(param_file_type), intent(in) :: param_file !< A structure to parse @@ -532,6 +534,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" !! structure, used to pass around pointers !! to various arrays for diagnostic purposes. + type(MEKE_type), pointer :: MEKE !< MEKE data type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions !! are used, this points to the ocean_OBC_type !! that was set up in MOM_initialization. @@ -609,12 +612,12 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag Accel_diag%PFu => CS%PFu ; Accel_diag%PFv => CS%PFv Accel_diag%CAu => CS%CAu ; Accel_diag%CAv => CS%CAv - call continuity_init(Time, G, GV, param_file, diag, CS%continuity_CSp) - call CoriolisAdv_init(Time, G, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) + call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) + call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv_CSp) if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) - call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp) + call hor_visc_init(Time, G, US, param_file, diag, CS%hor_visc_CSp, MEKE) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) if (.not.associated(setVisc_CSp)) call MOM_error(FATAL, & @@ -628,18 +631,18 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag H_convert = GV%H_to_m ; if (.not.GV%Boussinesq) H_convert = GV%H_to_kg_m2 CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & 'Zonal Thickness Flux', flux_units, y_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_vh = register_diag_field('ocean_model', 'vh', diag%axesCvL, Time, & 'Meridional Thickness Flux', flux_units, x_cell_method='sum', v_extensive=.true., & - conversion=H_convert) + conversion=H_convert*US%L_to_m**2*US%s_to_T) CS%id_CAu = register_diag_field('ocean_model', 'CAu', diag%axesCuL, Time, & - 'Zonal Coriolis and Advective Acceleration', 'meter second-2') + 'Zonal Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_CAv = register_diag_field('ocean_model', 'CAv', diag%axesCvL, Time, & - 'Meridional Coriolis and Advective Acceleration', 'meter second-2') + 'Meridional Coriolis and Advective Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFu = register_diag_field('ocean_model', 'PFu', diag%axesCuL, Time, & - 'Zonal Pressure Force Acceleration', 'meter second-2') + 'Zonal Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & - 'Meridional Pressure Force Acceleration', 'meter second-2') + 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 515697c09e..7df4213a2f 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -11,7 +11,7 @@ module MOM_forcing_type use MOM_EOS, only : calculate_density_derivs use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : sumSWoverBands, optics_type +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_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs @@ -50,13 +50,13 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. + ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness [Z s-1 ~> m s-1]. + !! any augmentation for gustiness [Z T-1 ~> m s-1]. ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & - buoy => NULL() !< buoyancy flux [m2 s-3] + buoy => NULL() !< buoyancy flux [L2 T-3 ~> m2 s-3] ! radiative heat fluxes into the ocean [W m-2] real, pointer, dimension(:,:) :: & @@ -131,16 +131,16 @@ module MOM_forcing_type ! tide related inputs real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer [W m-2] - ustar_tidal => NULL() !< tidal contribution to bottom ustar [m s-1] + ustar_tidal => NULL() !< tidal contribution to bottom ustar [Z T-1 ~> m s-1] ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z s-1 ~> m s-1]. + ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z T-1 ~> m s-1]. area_berg => NULL(), & !< area of ocean surface covered by icebergs [m2 m-2] mass_berg => NULL() !< mass of icebergs [kg m-2] ! land ice-shelf related inputs - real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z s-1 ~> m s-1]. + real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z T-1 ~> m s-1]. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of !! h-cells, nondimensional from 0 to 1. This is only @@ -187,7 +187,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress [Pa] tauy => NULL(), & !< meridional wind stress [Pa] - ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. + ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean [kg m-2 s-1]. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) @@ -375,7 +375,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean !! accumulated over a time step !! [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. + real, dimension(max(1,nsw),G%isd:G%ied), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. !! [degC H ~> degC m or degC kg m-2] !! and array size nsw x SZI_(G), where !! nsw=number of SW bands in pen_SW_bnd. @@ -398,7 +398,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), & optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean !! [H s-1 ~> m s-1 or kg m-2 s-1]. - real, dimension(:,:), & + real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics @@ -444,7 +444,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! error checking - if (nsw > 0) then ; if (nsw /= optics%nbands) call MOM_error(WARNING, & + if (nsw > 0) then ; if (nsw /= optics_nbands(optics)) call MOM_error(WARNING, & "mismatch in the number of bands of shortwave radiation in MOM_forcing_type extract_fluxes.") endif @@ -473,18 +473,22 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, do i=is,ie ; htot(i) = h(i,1) ; enddo do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,k) ; enddo ; enddo + if (nsw >= 1) then + call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) !, penSW_scale=J_m2_to_H*dt + if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) !, penSW_scale=J_m2_to_H + endif do i=is,ie scale = 1.0 if (htot(i)*Ih_limit < 1.0) scale = htot(i)*Ih_limit - ! Convert the penetrating shortwave forcing to (K * H) + ! Convert the penetrating shortwave forcing to (K * H) and reduce fluxes for shallow depths. ! (H=m for Bouss, H=kg/m2 for non-Bouss) Pen_sw_tot(i) = 0.0 if (nsw >= 1) then - do n=1,nsw - Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, optics%sw_pen_band(n,i,j)) + do n=1,nsw + Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, Pen_SW_bnd(n,i)) Pen_sw_tot(i) = Pen_sw_tot(i) + Pen_SW_bnd(n,i) enddo else @@ -495,7 +499,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, pen_sw_tot_rate(i) = 0.0 if (nsw >= 1) then do n=1,nsw - Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, optics%sw_pen_band(n,i,j)) + Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, Pen_SW_bnd_rate(n,i)) pen_sw_tot_rate(i) = pen_sw_tot_rate(i) + pen_sw_bnd_rate(n,i) enddo else @@ -834,10 +838,10 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated !! over a time step [ppt H ~> ppt m or ppt kg m-2] - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! [degC H ~> degC m or degC kg m-2] array size - !! nsw x SZI_(G), where nsw=number of SW bands in - !! pen_SW_bnd. This heat flux is not in net_heat. + real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_SW_bnd !< penetrating SW flux, by frequency + !! band [degC H ~> degC m or degC kg m-2] with array + !! size nsw x SZI_(G), where nsw=number of SW bands + !! in pen_SW_bnd. This heat flux is not in net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available !! thermodynamic fields. Here it is used to keep !! track of the heat flux associated with net @@ -863,19 +867,21 @@ end subroutine extractFluxes2d !! These are actual fluxes, with units of stuff per time. Setting dt=1 in the call to !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. -subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, & +subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, & buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) type(ocean_grid_type), intent(in) :: 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(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< penetrating SW optics + integer, intent(in) :: nsw !< The number of frequency bands of + !! penetrating shortwave radiation real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type integer, intent(in) :: j !< j-row to work on - real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux [m2 s-3] + real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux @@ -883,24 +889,26 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables - integer :: nsw, start, npts, k - real, parameter :: dt = 1. ! to return a rate from extractFluxes1d - real, dimension( SZI_(G) ) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension( SZI_(G) ) :: netEvap ! net FW flux leaving ocean via evaporation - ! [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension( SZI_(G) ) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] - real, dimension( optics%nbands, SZI_(G) ) :: penSWbnd ! SW penetration bands - real, dimension( SZI_(G) ) :: pressure ! pressurea the surface [Pa] - real, dimension( SZI_(G) ) :: dRhodT ! density partial derivative wrt temp [kg m-3 degC-1] - real, dimension( SZI_(G) ) :: dRhodS ! density partial derivative wrt saln [kg m-3 ppt-1] - real, dimension(SZI_(G),SZK_(G)+1) :: netPen + integer :: start, npts, k + real, parameter :: dt = 1. ! to return a rate from extractFluxes1d + real, dimension(SZI_(G)) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] + real, dimension(SZI_(G)) :: netEvap ! net FW flux leaving ocean via evaporation + ! [H s-1 ~> m s-1 or kg m-2 s-1] + real, dimension(SZI_(G)) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] + real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band + ! [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G)) :: pressure ! pressurea the surface [Pa] + real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [kg m-3 degC-1] + real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [kg m-3 ppt-1] + real, dimension(SZI_(G),SZK_(G)+1) :: netPen ! The net penetrating shortwave radiation at each level + ! [degC H ~> degC m or degC kg m-2] logical :: useRiverHeatContent logical :: useCalvingHeatContent - real :: depthBeforeScalingFluxes, GoRho - real :: H_limit_fluxes - - nsw = optics%nbands + real :: depthBeforeScalingFluxes ! A depth scale [H ~> m or kg m-2] + real :: GoRho ! The gravitational acceleration divided by mean density times some + ! unit conversion factors [L2 m3 H-1 s kg-1 T-3 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + real :: H_limit_fluxes ! Another depth scale [H ~> m or kg m-2] ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. @@ -908,7 +916,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, depthBeforeScalingFluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) pressure(:) = 0. ! Ignore atmospheric pressure - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = (GV%g_Earth*US%m_to_Z * GV%H_to_m*US%T_to_s) / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc @@ -928,7 +936,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, h(:,j,:), optics%opacity_band(:,:,j,:), nsw, j, dt, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics_nbands(optics), optics, j, dt*US%s_to_T, & H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives @@ -945,10 +953,10 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, ! 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) ) * GV%H_to_m ! m^2/s^3 + 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, G%ke+1 - buoyancyFlux(G%isc:G%iec,k) = - GoRho * ( dRhodT(G%isc:G%iec) * netPen(G%isc:G%iec,k) ) * GV%H_to_m ! m^2/s^3 + 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 end subroutine calculateBuoyancyFlux1d @@ -967,7 +975,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux [m2 s-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy fluxes [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux @@ -983,8 +991,8 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, !$OMP parallel do default(shared) firstprivate(netT,netS) do j=G%jsc,G%jec - call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & - netT, netS, skip_diags=skip_diags) + call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, optics_nbands(optics), h, Temp, Salt, & + tv, j, buoyancyFlux(:,j,:), netT, netS, skip_diags=skip_diags) if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) enddo @@ -1009,9 +1017,9 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(fluxes%ustar)) & - call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m) + call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%buoy)) & - call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI,haloshift=hshift) + call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI, haloshift=hshift, scale=US%L_to_m**2*US%s_to_T**3) if (associated(fluxes%sw)) & call hchksum(fluxes%sw, mesg//" fluxes%sw",G%HI,haloshift=hshift) if (associated(fluxes%sw_vis_dir)) & @@ -1053,7 +1061,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%TKE_tidal)) & call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal",G%HI,haloshift=hshift) if (associated(fluxes%ustar_tidal)) & - call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift) + call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%lrunoff)) & call hchksum(fluxes%lrunoff, mesg//" fluxes%lrunoff",G%HI,haloshift=hshift) if (associated(fluxes%frunoff)) & @@ -1096,7 +1104,7 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) if (associated(forces%ustar)) & - call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m) + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) @@ -1218,12 +1226,12 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & - 'm s-1', conversion=US%Z_to_m) + 'm s-1', conversion=US%Z_to_m*US%s_to_T) if (present(use_berg_fluxes)) then if (use_berg_fluxes) then handles%id_ustar_berg = register_diag_field('ocean_model', 'ustar_berg', diag%axesT1, Time, & - 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m) + 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m*US%s_to_T) handles%id_area_berg = register_diag_field('ocean_model', 'area_berg', diag%axesT1, Time, & 'Area of grid cell covered by iceberg ', 'm2 m-2') @@ -1232,7 +1240,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Mass of icebergs ', 'kg m-2') handles%id_ustar_ice_cover = register_diag_field('ocean_model', 'ustar_ice_cover', diag%axesT1, Time, & - 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m) + 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m*US%s_to_T) handles%id_frac_ice_cover = register_diag_field('ocean_model', 'frac_ice_cover', diag%axesT1, Time, & 'Area of grid cell below iceberg and ice shelf together ', 'm2 m-2') @@ -1249,7 +1257,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, if (.not. use_temperature) then handles%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, Time, & - 'Buoyancy forcing', 'm2 s-3') + 'Buoyancy forcing', 'm2 s-3', conversion=US%L_to_m**2*US%s_to_T**3) return endif @@ -2072,7 +2080,7 @@ 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)) - fluxes%ustar_gustless(i,j) = US%m_to_Z * sqrt(sqrt(taux2 + tauy2) / Rho0) + fluxes%ustar_gustless(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(taux2 + tauy2) / Rho0) !### Change to: ! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index b66aecd261..1a2d03bd44 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -8,6 +8,7 @@ module MOM_grid use MOM_domains, only : get_global_shape, get_domain_extent_dsamp2 use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -73,54 +74,54 @@ module MOM_grid !! set_first_direction. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid. Nd. + mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. - dxT, & !< dxT is delta x at h points [m]. - IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. - IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. - IareaT, & !< 1/areaT [m-2]. + dxT, & !< dxT is delta x at h points [L ~> m]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. + dyT, & !< dyT is delta y at h points [L ~> m]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions. cos_rot !< The cosine of the angular rotation between the local model grid's northward !! and the true northward directions. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid. Nondim. + mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. - dxCu, & !< dxCu is delta x at u points [m]. - IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. - IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. - areaCu !< The areas of the u-grid cells [m2]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid. Nondim. + mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. - dxCv, & !< dxCv is delta x at v points [m]. - IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. - IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. - areaCv !< The areas of the v-grid cells [m2]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid. Nondim. + mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. - dxBu, & !< dxBu is delta x at q points [m]. - IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. - IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. + areaBu, & !< areaBu is the area of a q-cell [L2 ~> m2] + 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. @@ -151,13 +152,16 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] - real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m2]. + real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2]. + + type(unit_scale_type), pointer :: US => NULL() !< A dimensional unit scaling type + ! These variables are for block structures. integer :: nblocks !< The number of sub-PE blocks on this PE @@ -176,9 +180,10 @@ module MOM_grid contains !> MOM_grid_init initializes the ocean grid array sizes and grid memory. -subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) +subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_vel) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type type(hor_index_type), & optional, intent(in) :: HI !< A hor_index_type for array extents logical, optional, intent(in) :: global_indexing !< If true use global index @@ -214,6 +219,8 @@ subroutine MOM_grid_init(G, param_file, HI, global_indexing, bathymetry_at_vel) "in the y-direction on each processor (for openmp).", default=1, & layoutParam=.true.) + if (present(US)) then ; if (associated(US)) G%US => US ; endif + if (present(HI)) then G%HI = HI @@ -402,8 +409,9 @@ subroutine rescale_grid_bathymetry(G, m_in_new_units) end subroutine rescale_grid_bathymetry !> set_derived_metrics calculates metric terms that are derived from other metrics. -subroutine set_derived_metrics(G) - type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure +subroutine set_derived_metrics(G, US) + type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. integer :: i, j, isd, ied, jsd, jed diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index de0064932d..7d12f0b9e9 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -67,7 +67,7 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) - I_gEarth = Z_to_eta / GV%g_Earth + I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) !$OMP parallel default(shared) private(dilate,htot) !$OMP do @@ -174,7 +174,7 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) Z_to_eta = 1.0 ; if (present(eta_to_m)) Z_to_eta = US%Z_to_m / eta_to_m H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_kg_m2 * (US%m_to_Z * Z_to_eta) - I_gEarth = Z_to_eta / GV%g_Earth + I_gEarth = Z_to_eta / (US%Z_to_m * GV%mks_g_Earth) !$OMP parallel default(shared) private(htot) !$OMP do diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 11975aa5dc..30a2a451a8 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -13,7 +13,7 @@ module MOM_isopycnal_slopes #include -public calc_isoneutral_slopes +public calc_isoneutral_slopes, vert_fill_TS ! 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 @@ -39,10 +39,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction [nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at - !! interfaces between u-points [s-2] + !! interfaces between u-points [[T-2 ~> s-2] integer, optional, intent(in) :: halo !< Halo width over which to compute ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units @@ -79,19 +79,18 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 Z-1 ~> kg m-4]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: slope2_Ratio ! The ratio of the slope squared to slope_max squared. 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 change in interface heighs that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. - logical :: use_EOS ! If true, density is calculated from T & S using an - ! equation of state. + logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0, N2, dzN2, H_x(SZIB_(G)), H_y(SZI_(G)) real :: Z_to_L ! A conversion factor between from units for e to the ! units for lateral distances. @@ -111,9 +110,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & nz = G%ke ; IsdB = G%IsdB h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = US%Z_to_m ; H_to_Z = GV%H_to_Z + Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z ! if (present(eta_to_m)) then - ! Z_to_L = eta_to_m ; H_to_Z = GV%H_to_m / eta_to_m + ! Z_to_L = eta_to_m*US%m_to_L ; H_to_Z = GV%H_to_m / eta_to_m ! endif L_to_Z = 1.0 / Z_to_L dz_neglect = GV%H_subroundoff * H_to_Z @@ -122,7 +121,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & present_N2_u = PRESENT(N2_u) present_N2_v = PRESENT(N2_v) - G_Rho0 = (GV%g_Earth*L_to_Z*US%m_to_Z) / GV%Rho0 + G_Rho0 = (US%L_to_Z*L_to_Z*GV%g_Earth) / GV%Rho0 if (present_N2_u) then do j=js,je ; do I=is-1,ie N2_u(I,j,1) = 0. @@ -157,7 +156,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, & enddo ; enddo enddo - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,pres,T,S,tv, & + !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & !$OMP h_neglect2,present_N2_u,G_Rho0,N2_u,slope_x) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & @@ -331,65 +330,79 @@ 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) +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, 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 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity [ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing !! times a smoothing timescale [Z2 ~> m2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity [ppt] - integer, optional, intent(in) :: halo_here !< Halo width over which to compute + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] + integer, optional, intent(in) :: halo_here !< Number of halo points to work on, + !! 0 by default + logical, optional, intent(in) :: larger_h_denom !< Present and true, add a large + !! enough minimal thickness in the denominator of + !! the flux calculations so that the fluxes are + !! never so large as eliminate the transmission + !! of information across groups of massless layers. ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep [H ~> m or kg m-2]. real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: kap_dt_x2 ! The product of 2*kappa*dt, converted to - ! the same units as h squared, [H2 ~> m2 or kg2 m-4]. - real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to - ! allow for zero thicknesses. + real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. + real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. + real :: h0 ! A negligible thickness to allow for zero thickness layers without + ! completely decouping groups of layers [H ~> m or kg m-2]. + ! Often 0 < h_neglect << h0. + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz, halo halo=0 ; if (present(halo_here)) halo = max(halo_here,0) - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - nz = G%ke + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke - kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 h_neglect = GV%H_subroundoff + kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 + h0 = h_neglect + if (present(larger_h_denom)) then + if (larger_h_denom) h0 = 1.0e-16*sqrt(kappa_dt)*GV%Z_to_H + endif if (kap_dt_x2 <= 0.0) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) enddo ; enddo ; enddo else -!$OMP parallel do default(none) private(ent,b1,d1,c1) & -!$OMP shared(is,ie,js,je,nz,kap_dt_x2,h,h_neglect,T_f,S_f,T_in,S_in) + !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) do j=js,je do i=is,ie - ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h_neglect) - b1(i) = 1.0 / (h(i,j,1)+ent(i,2)) - d1(i) = b1(i) * h(i,j,1) - T_f(i,j,1) = (b1(i)*h(i,j,1))*T_in(i,j,1) - S_f(i,j,1) = (b1(i)*h(i,j,1))*S_in(i,j,1) + ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) + h_tr = h(i,j,1) + h_neglect + b1(i) = 1.0 / (h_tr + ent(i,2)) + d1(i) = b1(i) * h_tr + T_f(i,j,1) = (b1(i)*h_tr)*T_in(i,j,1) + S_f(i,j,1) = (b1(i)*h_tr)*S_in(i,j,1) enddo do k=2,nz-1 ; do i=is,ie - ent(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h_neglect) + ent(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0) + h_tr = h(i,j,k) + h_neglect c1(i,k) = ent(i,K) * b1(i) - b1(i) = 1.0 / ((h(i,j,k) + d1(i)*ent(i,K)) + ent(i,K+1)) - d1(i) = b1(i) * (h(i,j,k) + d1(i)*ent(i,K)) - T_f(i,j,k) = b1(i) * (h(i,j,k)*T_in(i,j,k) + ent(i,K)*T_f(i,j,k-1)) - S_f(i,j,k) = b1(i) * (h(i,j,k)*S_in(i,j,k) + ent(i,K)*S_f(i,j,k-1)) + b1(i) = 1.0 / ((h_tr + d1(i)*ent(i,K)) + ent(i,K+1)) + d1(i) = b1(i) * (h_tr + d1(i)*ent(i,K)) + T_f(i,j,k) = b1(i) * (h_tr*T_in(i,j,k) + ent(i,K)*T_f(i,j,k-1)) + S_f(i,j,k) = b1(i) * (h_tr*S_in(i,j,k) + ent(i,K)*S_f(i,j,k-1)) enddo ; enddo do i=is,ie c1(i,nz) = ent(i,nz) * b1(i) - b1(i) = 1.0 / (h(i,j,nz) + d1(i)*ent(i,nz) + h_neglect) - T_f(i,j,nz) = b1(i) * (h(i,j,nz)*T_in(i,j,nz) + ent(i,nz)*T_f(i,j,nz-1)) - S_f(i,j,nz) = b1(i) * (h(i,j,nz)*S_in(i,j,nz) + ent(i,nz)*S_f(i,j,nz-1)) + h_tr = h(i,j,nz) + h_neglect + b1(i) = 1.0 / (h_tr + d1(i)*ent(i,nz)) + T_f(i,j,nz) = b1(i) * (h_tr*T_in(i,j,nz) + ent(i,nz)*T_f(i,j,nz-1)) + S_f(i,j,nz) = b1(i) * (h_tr*S_in(i,j,nz) + ent(i,nz)*S_f(i,j,nz-1)) enddo do k=nz-1,1,-1 ; do i=is,ie T_f(i,j,k) = T_f(i,j,k) + c1(i,k+1)*T_f(i,j,k+1) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5624167170..dbdc0b72c1 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -53,6 +53,7 @@ module MOM_open_boundary public register_temp_salt_segments public fill_temp_salt_segments public open_boundary_register_restarts +public update_segment_tracer_reservoirs integer, parameter, public :: OBC_NONE = 0 !< Indicates the use of no open boundary integer, parameter, public :: OBC_SIMPLE = 1 !< Indicates the use of a simple inflow open boundary @@ -124,7 +125,13 @@ module MOM_open_boundary logical :: specified_tan !< Boundary tangential velocity fixed to external value. logical :: open !< Boundary is open for continuity solver. logical :: gradient !< Zero gradient at boundary. - logical :: values_needed !< Whether or not external OBC fields are needed. + logical :: values_needed !< Whether or not any external OBC fields are needed. + logical :: u_values_needed!< Whether or not external u OBC fields are needed. + logical :: v_values_needed!< Whether or not external v OBC fields are needed. + logical :: t_values_needed!< Whether or not external T OBC fields are needed. + logical :: s_values_needed!< Whether or not external S OBC fields are needed. + logical :: z_values_needed!< Whether or not external zeta OBC fields are needed. + logical :: g_values_needed!< Whether or not external gradient OBC fields are needed. integer :: direction !< Boundary faces one of the four directions. logical :: is_N_or_S !< True is the OB is facing North or South and exists on this PE. logical :: is_E_or_W !< True is the OB is facing East or West and exists on this PE. @@ -142,25 +149,25 @@ module MOM_open_boundary logical :: salt_segment_data_exists !< true if salinity data arrays are present real, pointer, dimension(:,:) :: Cg=>NULL() !< The external gravity wave speed [m s-1] !! at OBC-points. - real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [m] at OBC-points. - real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [m] at OBC-points. + real, pointer, dimension(:,:) :: Htot=>NULL() !< The total column thickness [H ~> m or kg m-2] at OBC-points. + real, pointer, dimension(:,:,:) :: h=>NULL() !< The cell thickness [H ~> m or kg m-2] at OBC-points. real, pointer, dimension(:,:,:) :: normal_vel=>NULL() !< The layer velocity normal to the OB - !! segment [m s-1]. + !! segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_vel=>NULL() !< The layer velocity tangential to the - !! OB segment [m s-1]. + !! OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: tangential_grad=>NULL() !< The gradient of the velocity tangential - !! to the OB segment [m s-1]. + !! to the OB segment [T-1 ~> s-1]. real, pointer, dimension(:,:,:) :: normal_trans=>NULL() !< The layer transport normal to the OB - !! segment [m3 s-1]. + !! segment [H L2 T-1 ~> m3 s-1]. real, pointer, dimension(:,:) :: normal_vel_bt=>NULL() !< The barotropic velocity normal to - !! the OB segment [m s-1]. + !! the OB segment [L T-1 ~> m s-1]. real, pointer, dimension(:,:) :: eta=>NULL() !< The sea-surface elevation along the segment [m]. real, pointer, dimension(:,:,:) :: grad_normal=>NULL() !< The gradient of the normal flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_tan=>NULL() !< The gradient of the tangential flow along the - !! segment [s-1] + !! segment [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: grad_gradient=>NULL() !< The gradient of the gradient of tangential flow along the - !! segment [m-1 s-1] + !! segment times a grid spacing [T-1 ~> s-1] real, pointer, dimension(:,:,:) :: rx_normal=>NULL() !< The rx_old_u value for radiation coeff !! for normal velocity real, pointer, dimension(:,:,:) :: ry_normal=>NULL() !< The tangential value for radiation coeff @@ -168,18 +175,18 @@ module MOM_open_boundary real, pointer, dimension(:,:,:) :: cff_normal=>NULL() !< The denominator for oblique radiation !! for normal velocity real, pointer, dimension(:,:,:) :: nudged_normal_vel=>NULL() !< The layer velocity normal to the OB segment - !! that values should be nudged towards [m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_vel=>NULL() !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: nudged_tangential_grad=>NULL() !< The layer dvdx or dudy towards which nudging - !! can occur [s-1]. + !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. type(hor_index_type) :: HI !< Horizontal index ranges - real :: Tr_InvLscale3_out !< An effective inverse length scale cubed [m-3] - real :: Tr_InvLscale3_in !< for restoring the tracer concentration in a - !! ficticious reservior towards interior values - !! when flow is exiting the domain, or towards - !! an externally imposed value when flow is entering + real :: Tr_InvLscale_out !< An effective inverse length scale [m-1] + real :: Tr_InvLscale_in !< for restoring the tracer concentration in a + !! ficticious reservior towards interior values + !! when flow is exiting the domain, or towards + !! an externally imposed value when flow is entering end type OBC_segment_type !> Open-boundary data @@ -320,7 +327,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) call get_param(param_file, mdl, "NK", OBC%ke, & "The number of model layers", default=0, do_not_log=.true.) - if (config1 /= "none") OBC%user_BCs_set_globally = .true. + if (config1 /= "none" .and. config1 /= "dyed_obcs") OBC%user_BCs_set_globally = .true. if (OBC%number_of_segments > 0) then call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & @@ -418,12 +425,18 @@ subroutine open_boundary_config(G, US, param_file, OBC) OBC%segment(l)%open = .false. OBC%segment(l)%gradient = .false. OBC%segment(l)%values_needed = .false. + OBC%segment(l)%u_values_needed = .false. + OBC%segment(l)%v_values_needed = .false. + OBC%segment(l)%t_values_needed = .false. + OBC%segment(l)%s_values_needed = .false. + OBC%segment(l)%z_values_needed = .false. + OBC%segment(l)%g_values_needed = .false. OBC%segment(l)%direction = OBC_NONE OBC%segment(l)%is_N_or_S = .false. OBC%segment(l)%is_E_or_W = .false. OBC%segment(l)%Velocity_nudging_timescale_in = 0.0 OBC%segment(l)%Velocity_nudging_timescale_out = 0.0 - OBC%segment(l)%num_fields = 0.0 + OBC%segment(l)%num_fields = 0 enddo allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%segnum_u(:,:) = OBC_NONE allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%segnum_v(:,:) = OBC_NONE @@ -482,10 +495,10 @@ subroutine open_boundary_config(G, US, param_file, OBC) ! tracer-specific in the future for example, in cases where certain tracers are poorly constrained ! by data while others are well constrained - MJH. do l = 1, OBC%number_of_segments - OBC%segment(l)%Tr_InvLscale3_in=0.0 - if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale3_in = 1.0/(Lscale_in*Lscale_in*Lscale_in) - OBC%segment(l)%Tr_InvLscale3_out=0.0 - if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale3_out = 1.0/(Lscale_out*Lscale_out*Lscale_out) + OBC%segment(l)%Tr_InvLscale_in=0.0 + if (Lscale_in>0.) OBC%segment(l)%Tr_InvLscale_in = 1.0/Lscale_in + OBC%segment(l)%Tr_InvLscale_out=0.0 + if (Lscale_out>0.) OBC%segment(l)%Tr_InvLscale_out = 1.0/Lscale_out enddo endif ! OBC%number_of_segments > 0 @@ -526,6 +539,7 @@ subroutine initialize_segment_data(G, OBC, PF) character(len=128) :: inputdir type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list character(len=32) :: remappingScheme + character(len=256) :: mesg ! Message for error messages. logical :: check_reconstruction, check_remapping, force_bounds_in_subcell integer, dimension(4) :: siz,siz2 integer :: is, ie, js, je @@ -591,13 +605,20 @@ subroutine initialize_segment_data(G, OBC, PF) do n=1, OBC%number_of_segments segment => OBC%segment(n) + if (.not. segment%values_needed) cycle write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n write(suffix,"('_segment_',i3.3)") n ! needs documentation !! Yet, unsafe for now, causes grief for ! MOM_parameter_docs in circle_obcs on two processes. ! call get_param(PF, mdl, segnam, segstr, 'xyz') + ! Clear out any old values + segstr = '' call get_param(PF, mdl, segnam, segstr) + if (segstr == '') then + write(mesg,'("No OBC_SEGMENT_XXX_DATA string for OBC segment ",I3)') n + call MOM_error(FATAL, mesg) + endif call parse_segment_data_str(trim(segstr), fields=fields, num_fields=num_fields) if (num_fields == 0) then @@ -607,12 +628,13 @@ subroutine initialize_segment_data(G, OBC, PF) allocate(segment%field(num_fields)) - if (segment%Flather) then - if (num_fields < 3) call MOM_error(FATAL, & - "MOM_open_boundary, initialize_segment_data: "//& - "Need at least three inputs for Flather") - endif - segment%num_fields = num_fields ! these are at least three input fields required for the Flather option +! This should be happening with the x_values_needed. +! if (segment%Flather) then +! if (num_fields < 3) call MOM_error(FATAL, & +! "MOM_open_boundary, initialize_segment_data: "//& +! "Need at least three inputs for Flather") +! endif + segment%num_fields = num_fields segment%temp_segment_data_exists=.false. segment%salt_segment_data_exists=.false. @@ -630,16 +652,20 @@ subroutine initialize_segment_data(G, OBC, PF) if (trim(filename) /= 'none') then OBC%update_OBC = .true. ! Data is assumed to be time-dependent if we are reading from file OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data - segment%values_needed = .true. ! Indicates that i/o will be needed for this segment +! segment%values_needed = .true. ! Indicates that i/o will be needed for this segment segment%field(m)%name = trim(fields(m)) - if (segment%field(m)%name == 'TEMP') & + if (segment%field(m)%name == 'TEMP') then segment%temp_segment_data_exists=.true. - if (segment%field(m)%name == 'SALT') & + segment%t_values_needed = .false. + endif + if (segment%field(m)%name == 'SALT') then segment%salt_segment_data_exists=.true. + segment%s_values_needed = .false. + endif filename = trim(inputdir)//trim(filename) fieldname = trim(fieldname)//trim(suffix) call field_size(filename,fieldname,siz,no_domain=.true.) - if (siz(4) == 1) segment%values_needed = .false. +! 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 call MOM_error(FATAL,'segment data are not on the supergrid') @@ -664,16 +690,42 @@ subroutine initialize_segment_data(G, OBC, PF) siz2(3)=siz(3) if (segment%is_E_or_W) then - if (segment%field(m)%name == 'V' .or. segment%field(m)%name == 'DVDX') then + if (segment%field(m)%name == 'V') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%v_values_needed = .false. + else if (segment%field(m)%name == 'DVDX') then + allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%g_values_needed = .false. else allocate(segment%field(m)%buffer_src(IsdB:IedB,jsd:jed,siz2(3))) + if (segment%field(m)%name == 'U') then + segment%u_values_needed = .false. + else if (segment%field(m)%name == 'SSH') then + segment%z_values_needed = .false. + else if (segment%field(m)%name == 'TEMP') then + segment%t_values_needed = .false. + else if (segment%field(m)%name == 'SALT') then + segment%s_values_needed = .false. + endif endif else - if (segment%field(m)%name == 'U' .or. segment%field(m)%name == 'DUDY') then + if (segment%field(m)%name == 'U') then allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%u_values_needed = .false. + else if (segment%field(m)%name == 'DUDY') then + allocate(segment%field(m)%buffer_src(IsdB:IedB,JsdB:JedB,siz2(3))) + segment%g_values_needed = .false. else allocate(segment%field(m)%buffer_src(isd:ied,JsdB:JedB,siz2(3))) + if (segment%field(m)%name == 'V') then + segment%v_values_needed = .false. + else if (segment%field(m)%name == 'SSH') then + segment%z_values_needed = .false. + else if (segment%field(m)%name == 'TEMP') then + segment%t_values_needed = .false. + else if (segment%field(m)%name == 'SALT') then + segment%s_values_needed = .false. + endif endif endif segment%field(m)%buffer_src(:,:,:)=0.0 @@ -706,8 +758,28 @@ subroutine initialize_segment_data(G, OBC, PF) else segment%field(m)%fid = -1 segment%field(m)%value = value + segment%field(m)%name = trim(fields(m)) + if (segment%field(m)%name == 'U') then + segment%u_values_needed = .false. + elseif (segment%field(m)%name == 'V') then + segment%v_values_needed = .false. + elseif (segment%field(m)%name == 'SSH') then + segment%z_values_needed = .false. + elseif (segment%field(m)%name == 'TEMP') then + segment%t_values_needed = .false. + elseif (segment%field(m)%name == 'SALT') then + segment%s_values_needed = .false. + elseif (segment%field(m)%name == 'DVDX' .or. segment%field(m)%name == 'DUDY') then + segment%g_values_needed = .false. + endif endif enddo + if (segment%u_values_needed .or. segment%v_values_needed .or. & + segment%t_values_needed .or. segment%s_values_needed .or. & + segment%z_values_needed .or. segment%g_values_needed) then + write(mesg,'("Values needed for OBC segment ",I3)') n + call MOM_error(FATAL, mesg) + endif enddo call mpp_set_current_pelist(saved_pelist) @@ -814,6 +886,8 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) OBC%segment(l_seg)%open = .true. OBC%Flather_u_BCs_exist_globally = .true. OBC%open_u_BCs_exist_globally = .true. + OBC%segment%z_values_needed = .true. + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'ORLANSKI') then OBC%segment(l_seg)%radiation = .true. OBC%segment(l_seg)%open = .true. @@ -841,11 +915,14 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_u_BCs_exist_globally = .true. + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_u_BCs_exist_globally = .true. + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then OBC%segment(l_seg)%nudged_grad = .true. + OBC%segment%g_values_needed = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -853,6 +930,7 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_u_BCs_exist_globally = .true. ! This avoids deallocation + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then OBC%segment(l_seg)%specified_tan = .true. else @@ -895,6 +973,10 @@ subroutine setup_u_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_y) call MOM_error(FATAL, "MOM_open_boundary.F90, setup_u_point_obc: \n"//& "Orlanski and Oblique OBC options cannot be used together on one segment.") + if (OBC%segment(l_seg)%u_values_needed .or. OBC%segment(l_seg)%v_values_needed .or. & + OBC%segment(l_seg)%t_values_needed .or. OBC%segment(l_seg)%s_values_needed .or. & + OBC%segment(l_seg)%z_values_needed .or. OBC%segment(l_seg)%g_values_needed) & + OBC%segment(l_seg)%values_needed = .true. end subroutine setup_u_point_obc !> Parse an OBC_SEGMENT_%%% string starting with "J=" and configure placement and type of OBC accordingly @@ -938,6 +1020,8 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) OBC%segment(l_seg)%open = .true. OBC%Flather_v_BCs_exist_globally = .true. OBC%open_v_BCs_exist_globally = .true. + OBC%segment%z_values_needed = .true. + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'ORLANSKI') then OBC%segment(l_seg)%radiation = .true. OBC%segment(l_seg)%open = .true. @@ -965,11 +1049,14 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) elseif (trim(action_str(a_loop)) == 'NUDGED') then OBC%segment(l_seg)%nudged = .true. OBC%nudged_v_BCs_exist_globally = .true. + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_TAN') then OBC%segment(l_seg)%nudged_tan = .true. OBC%nudged_v_BCs_exist_globally = .true. + OBC%segment%u_values_needed = .true. elseif (trim(action_str(a_loop)) == 'NUDGED_GRAD') then OBC%segment(l_seg)%nudged_grad = .true. + OBC%segment%g_values_needed = .true. elseif (trim(action_str(a_loop)) == 'GRADIENT') then OBC%segment(l_seg)%gradient = .true. OBC%segment(l_seg)%open = .true. @@ -977,6 +1064,7 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) elseif (trim(action_str(a_loop)) == 'SIMPLE') then OBC%segment(l_seg)%specified = .true. OBC%specified_v_BCs_exist_globally = .true. ! This avoids deallocation + OBC%segment%v_values_needed = .true. elseif (trim(action_str(a_loop)) == 'SIMPLE_TAN') then OBC%segment(l_seg)%specified_tan = .true. else @@ -1019,6 +1107,10 @@ subroutine setup_v_point_obc(OBC, G, segment_str, l_seg, PF, reentrant_x) call MOM_error(FATAL, "MOM_open_boundary.F90, setup_v_point_obc: \n"//& "Orlanski and Oblique OBC options cannot be used together on one segment.") + if (OBC%segment(l_seg)%u_values_needed .or. OBC%segment(l_seg)%v_values_needed .or. & + OBC%segment(l_seg)%t_values_needed .or. OBC%segment(l_seg)%s_values_needed .or. & + OBC%segment(l_seg)%z_values_needed .or. OBC%segment(l_seg)%g_values_needed) & + OBC%segment(l_seg)%values_needed = .true. end subroutine setup_v_point_obc !> Parse an OBC_SEGMENT_%%% string @@ -1410,11 +1502,12 @@ end subroutine open_boundary_impose_normal_slope !> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed. !! Also adjust u- and v-point cell area on specified open boundaries and mask all !! points outside open boundaries. -subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) +subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [m2] + type(dyn_horgrid_type), intent(inout) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: areaCu !< Area of a u-cell [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: areaCv !< Area of a u-cell [L2 ~> m2] ! Local variables integer :: i, j, n type(OBC_segment_type), pointer :: segment => NULL() @@ -1473,9 +1566,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed if (segment%direction == OBC_DIRECTION_E) then - areaCu(I,j) = G%areaT(i,j) + areaCu(I,j) = G%areaT(i,j) ! Both of these are in [L2] else ! West - areaCu(I,j) = G%areaT(i+1,j) + areaCu(I,j) = G%areaT(i+1,j) ! Both of these are in [L2] endif enddo else @@ -1483,9 +1576,9 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied if (segment%direction == OBC_DIRECTION_S) then - areaCv(i,J) = G%areaT(i,j+1) + areaCv(i,J) = G%areaT(i,j+1) ! Both of these are in [L2] else ! North - areaCu(i,J) = G%areaT(i,j) + areaCu(i,J) = G%areaT(i,j) ! Both of these are in [L2] endif enddo endif @@ -1519,20 +1612,22 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv) end subroutine open_boundary_impose_land_mask !> Apply radiation conditions to 3D u,v at open boundaries -subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) +subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, US, dt) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new !< On exit, new u values on open boundaries - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old !< Original unadjusted u [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new !< On exit, new v values on open boundaries. - !! On entry, the old time-level v but - !! including barotropic accelerations. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v - real, intent(in) :: dt !< Appropriate timestep + !! On entry, the old time-level v but including + !! barotropic accelerations [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old !< Original unadjusted v [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: dt !< Appropriate timestep [s] ! Local variables - real :: dhdt, dhdx, dhdy, gamma_u, gamma_v, gamma_2 + real :: dhdt, dhdx, dhdy ! One-point differences in time or space [L T-1 ~> m s-1] + real :: gamma_u, gamma_v, gamma_2 real :: cff, Cx, Cy, tau real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation @@ -1541,7 +1636,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) real, pointer, dimension(:,:,:) :: rx_tangential=>NULL() real, pointer, dimension(:,:,:) :: ry_tangential=>NULL() real, pointer, dimension(:,:,:) :: cff_tangential=>NULL() - real, parameter :: eps = 1.0e-20 + real :: eps ! A small velocity squared [L2 T-2 ~> m2 s-2]? type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, nz, n integer :: is_obc, ie_obc, js_obc, je_obc @@ -1553,6 +1648,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (.not.(OBC%open_u_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally)) & return + eps = 1.0e-20*US%m_s_to_L_T**2 + !! Copy previously calculated phase velocity from global arrays into segments !! This is terribly inefficient and temporary solution for continuity across restarts !! and needs to be revisited in the future. @@ -1600,14 +1697,14 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe) cycle - if (segment%oblique) call gradient_at_q_points(G,segment,u_new,v_new) + if (segment%oblique) call gradient_at_q_points(G, segment, u_new(:,:,:), v_new(:,:,:)) if (segment%direction == OBC_DIRECTION_E) then I=segment%HI%IsdB if (I 0.0) rx_new = min( (dhdt/dhdx), rx_max) ! outward phase speed rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1620,8 +1717,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new - dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 + dhdt = (u_old(I-1,j,k) - u_new(I-1,j,k)) !old-new + dhdx = (u_new(I-1,j,k) - u_new(I-2,j,k)) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1630,9 +1727,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff,max(dhdt*dhdy,-cff)) + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -1640,7 +1737,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -1697,11 +1795,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I-1,j) > 0.0 .and. G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k))*dt*G%IdxBu(I-1,J) +! rx_avg = 0.5*(u_new(I-1,j,k) + u_new(I-1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j) > 0.0) then -! rx_avg = u_new(I-1,j,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! elseif (G%mask2dCu(I-1,j+1) > 0.0) then -! rx_avg = u_new(I-1,j+1,k)*dt*G%IdxBu(I-1,J) +! rx_avg = u_new(I-1,j+1,k) * US%s_to_T*dt * G%IdxBu(I-1,J) ! else ! rx_avg = 0.0 ! endif @@ -1748,8 +1846,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i,J,k) + rx_avg*v_new(i-1,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1772,10 +1871,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) & - + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i,J,k) - v_new(i-1,J,k))*G%IdxBu(I-1,J) + & + rx_avg*(v_new(i-1,J,k) - v_new(i-2,J,k))*G%IdxBu(I-2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1802,8 +1903,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (I>G%HI%IecB) cycle do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed if (segment%radiation) then - dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new - dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 rx_new = 0.0 if (dhdt*dhdx > 0.0) rx_new = min( (dhdt/dhdx), rx_max) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new @@ -1816,8 +1917,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) elseif (segment%oblique) then - dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new - dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time forward sasha for I+1 + dhdt = (u_old(I+1,j,k) - u_new(I+1,j,k)) !old-new + dhdx = (u_new(I+1,j,k) - u_new(I+2,j,k)) !in new time forward sasha for I+1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then dhdy = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then @@ -1826,9 +1927,10 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdy = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 - rx_new = dhdt*dhdx - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - ry_new = min(cff,max(dhdt*dhdy,-cff)) + + rx_new = US%L_T_to_m_s**2*dhdt*dhdx + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + ry_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdy,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new @@ -1836,8 +1938,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & - (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & + min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & + (cff_avg + rx_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -1893,11 +1996,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do J=Js_obc,Je_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCu(I+1,j) > 0.0 .and. G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k))*dt*G%IdxBu(I+1,J) +! rx_avg = 0.5*(u_new(I+1,j,k) + u_new(I+1,j+1,k)) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j) > 0.0) then -! rx_avg = u_new(I+1,j,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! elseif (G%mask2dCu(I+1,j+1) > 0.0) then -! rx_avg = u_new(I+1,j+1,k)*dt*G%IdxBu(I+1,J) +! rx_avg = u_new(I+1,j+1,k) * US%s_to_T*dt * G%IdxBu(I+1,J) ! else ! rx_avg = 0.0 ! endif @@ -1944,8 +2047,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*v_new(i+1,J,k) + rx_avg*v_new(i+2,J,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(j,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(j+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -1968,10 +2072,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) & - + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & - (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(v_new(i+2,J,k) - v_new(i+1,J,k))*G%IdxBu(I+1,J) + & + rx_avg*(v_new(i+3,J,k) - v_new(i+2,J,k))*G%IdxBu(I+2,J)) - & + (max(ry_avg,0.0)*segment%grad_gradient(J,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(J+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -1998,8 +2104,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (J 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2012,9 +2118,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = v_old(i,J-1,k)-v_new(i,J-1,k) !old-new - dhdy = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1 - segment%ry_normal(i,J,k) = ry_avg + dhdt = (v_old(i,J-1,k) - v_new(i,J-1,k)) !old-new + dhdy = (v_new(i,J-1,k) - v_new(i,J-2,k)) !in new time backward sasha for J-1 + if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -2023,9 +2129,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff,max(dhdt*dhdx,-cff)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -2033,8 +2139,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & - (cff_avg + ry_avg) + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) +& + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability OBC%rx_normal(I,j,k) = segment%rx_normal(I,j,k) @@ -2090,15 +2197,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J-1) > 0.0 .and. G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1)) +! rx_avg = 0.5*(v_new(i,J-1,k) + v_new(i+1,J-1,k) * US%s_to_T*dt * G%IdyBu(I,J-1)) ! elseif (G%mask2dCv(i,J-1) > 0.0) then -! rx_avg = v_new(i,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! elseif (G%mask2dCv(i+1,J-1) > 0.0) then -! rx_avg = v_new(i+1,J-1,k)*dt*G%IdyBu(I,J-1) +! rx_avg = v_new(i+1,J-1,k) * US%s_to_T*dt *G%IdyBu(I,J-1) ! else ! rx_avg = 0.0 ! endif - segment%tangential_grad(I,J,k) = ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + segment%tangential_grad(I,J,k) = & + ((u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) / (1.0+rx_avg) enddo ; enddo endif @@ -2141,8 +2249,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I,j-1,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2165,10 +2274,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) & - + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(u_new(I,j,k) - u_new(I,j-1,k))*G%IdyBu(I,J-1) + & + rx_avg*(u_new(I,j-1,k) - u_new(I,j-2,k))*G%IdyBu(I,J-2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(I,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(I+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2195,8 +2306,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) if (J>G%HI%JecB) cycle do k=1,nz ; do i=segment%HI%isd,segment%HI%ied if (segment%radiation) then - dhdt = v_old(i,J+1,k)-v_new(i,J+1,k) !old-new - dhdy = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J-1 + dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 ry_new = 0.0 if (dhdt*dhdy > 0.0) ry_new = min( (dhdt/dhdy), ry_max) ry_avg = (1.0-gamma_v)*segment%ry_normal(I,j,k) + gamma_v*ry_new @@ -2209,8 +2320,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) ! implemented as a work-around to limitations in restart capability OBC%ry_normal(i,J,k) = segment%ry_normal(i,J,k) elseif (segment%oblique) then - dhdt = v_old(i,J+1,k)-v_new(i,J+1,k) !old-new - dhdy = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J-1 + dhdt = (v_old(i,J+1,k) - v_new(i,J+1,k)) !old-new + dhdy = (v_new(i,J+1,k) - v_new(i,J+2,k)) !in new time backward sasha for J-1 if (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) > 0.0) then dhdx = segment%grad_normal(I-1,1,k) elseif (dhdt*(segment%grad_normal(I,1,k) + segment%grad_normal(I-1,1,k)) == 0.0) then @@ -2219,9 +2330,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdx = segment%grad_normal(I,1,k) endif if (dhdt*dhdy < 0.0) dhdt = 0.0 - ry_new = dhdt*dhdy - cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) - rx_new = min(cff,max(dhdt*dhdx,-cff)) + ry_new = US%L_T_to_m_s**2*dhdt*dhdy + cff_new = US%L_T_to_m_s**2*max(dhdx*dhdx + dhdy*dhdy, eps) + rx_new = min(cff_new,max(US%L_T_to_m_s**2*dhdt*dhdx,-cff_new)) rx_avg = (1.0-gamma_u)*segment%rx_normal(I,j,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_normal(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new @@ -2229,7 +2340,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) segment%ry_normal(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & - (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & + (max(rx_avg,0.0)*segment%grad_normal(I-1,2,k) + & + min(rx_avg,0.0)*segment%grad_normal(I,2,k))) / & (cff_avg + ry_avg) ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability @@ -2286,11 +2398,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) do k=1,nz ; do I=Is_obc,Ie_obc rx_avg = rx_tangential(I,J,k) ! if (G%mask2dCv(i,J+1) > 0.0 .and. G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k))*dt*G%IdyBu(I,J+1) +! rx_avg = 0.5*(v_new(i,J+1,k) + v_new(i+1,J+1,k)) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i,J+1) > 0.0) then -! rx_avg = v_new(i,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! elseif (G%mask2dCv(i+1,J+1) > 0.0) then -! rx_avg = v_new(i+1,J+1,k)*dt*G%IdyBu(I,J+1) +! rx_avg = v_new(i+1,J+1,k) * US%s_to_T*dt * G%IdyBu(I,J+1) ! else ! rx_avg = 0.0 ! endif @@ -2336,9 +2448,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_vel(I,J,k) = ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & - (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_vel(I,J,k) = & + ((cff_avg*u_new(I,j+1,k) + rx_avg*u_new(I,j+2,k)) - & + (max(ry_avg,0.0)*segment%grad_tan(i,2,k) + & + min(ry_avg,0.0)*segment%grad_tan(i+1,2,k)) ) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_tan) then @@ -2351,7 +2465,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) endif gamma_2 = dt / (tau + dt) segment%tangential_vel(I,J,k) = (1 - gamma_2) * segment%tangential_vel(I,J,k) + & - gamma_2 * segment%nudged_tangential_vel(I,J,k) + gamma_2 * segment%nudged_tangential_vel(I,J,k) enddo ; enddo endif if (segment%oblique_grad) then @@ -2361,10 +2475,12 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) rx_avg = rx_tangential(I,J,k) ry_avg = ry_tangential(I,J,k) cff_avg = cff_tangential(I,J,k) - segment%tangential_grad(I,J,k) = ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) & - + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & - (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & - (cff_avg + rx_avg) + segment%tangential_grad(I,J,k) = & + ((cff_avg*(u_new(I,j+2,k) - u_new(I,j+1,k))*G%IdyBu(I,J+1) + & + rx_avg*(u_new(I,j+3,k) - u_new(I,j+2,k))*G%IdyBu(I,J+2)) - & + (max(ry_avg,0.0)*segment%grad_gradient(i,2,k) + & + min(ry_avg,0.0)*segment%grad_gradient(i+1,2,k))) / & + (cff_avg + rx_avg) enddo ; enddo endif if (segment%nudged_grad) then @@ -2399,8 +2515,10 @@ subroutine open_boundary_apply_normal_flow(OBC, G, u, v) ! Arguments type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open boundaries - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open boundaries + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< u field to update on open + !! boundaries [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< v field to update on open + !! boundaries [L T-1 ~> m s-1] ! Local variables integer :: i, j, k, n type(OBC_segment_type), pointer :: segment => NULL() @@ -2464,8 +2582,8 @@ end subroutine open_boundary_zero_normal_flow subroutine gradient_at_q_points(G, segment, uvel, vvel) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(OBC_segment_type), pointer :: segment !< OBC segment structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uvel !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vvel !< meridional velocity [L T-1 ~> m s-1] integer :: i,j,k if (.not. segment%on_pe) return @@ -2544,6 +2662,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? segment%grad_gradient(i,1,k) = (((uvel(I,j-1,k) - uvel(I,j-2,k))*G%IdxBu(I,J-2)) - & (uvel(I-1,j-1,k) - uvel(I-1,j-2,k))*G%IdxBu(I-1,J-2)) * G%mask2dCv(I,j-1) segment%grad_gradient(i,2,k) = (((uvel(I,j,k) - uvel(I,j-1,k))*G%IdyBu(I,J-1)) - & @@ -2570,6 +2689,7 @@ subroutine gradient_at_q_points(G, segment, uvel, vvel) if (segment%oblique_grad) then do k=1,G%ke do I=max(segment%HI%isd, G%HI%isd+1),min(segment%HI%ied, G%HI%ied-1) + !### The combination of differences in j and Idx here do not make sense to me. All should be Idy? segment%grad_gradient(i,1,k) = (((uvel(I,j+3,k) - uvel(I,j+2,k))*G%IdxBu(I,J+2)) - & (uvel(I-1,j+3,k) - uvel(I-1,j+2,k))*G%IdyBu(I-1,J+2)) * G%mask2dCv(i,J+2) segment%grad_gradient(i,2,k) = (((uvel(I,j+2,k) - uvel(I,j+1,k))*G%IdxBu(I,J+1)) - & @@ -2917,9 +3037,10 @@ subroutine open_boundary_test_extern_h(G, OBC, h) end subroutine open_boundary_test_extern_h !> Update the OBC values on the segments. -subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) +subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) 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 type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness [m] @@ -2980,7 +3101,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%Cg(I,j) = sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) + segment%Cg(I,j) = US%L_T_to_m_s*sqrt(GV%g_prime(1)*G%bathyT(i+ishift,j)) segment%Htot(I,j)=0.0 do k=1,G%ke segment%h(I,j,k) = h(i+ishift,j,k) @@ -2993,7 +3114,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%Cg(i,J) = sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) + segment%Cg(i,J) = US%L_T_to_m_s*sqrt(GV%g_prime(1)*G%bathyT(i,j+jshift)) segment%Htot(i,J)=0.0 do k=1,G%ke segment%h(i,J,k) = h(i,j+jshift,k) @@ -3143,6 +3264,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) endif endif + call adjustSegmentEtaToFitBathymetry(G,GV,US,segment,m) + if (segment%is_E_or_W) then ishift=1 if (segment%direction == OBC_DIRECTION_E) ishift=0 @@ -3251,6 +3374,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) allocate(segment%field(m)%bt_vel(is_obc:ie_obc,js_obc+1:je_obc)) elseif (segment%field(m)%name == 'DVDX') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + elseif (segment%field(m)%name == 'SSH') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc+1:je_obc,G%ke)) endif @@ -3263,6 +3388,8 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) allocate(segment%field(m)%bt_vel(is_obc+1:ie_obc,js_obc:je_obc)) elseif (segment%field(m)%name == 'DUDY') then allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,G%ke)) + elseif (segment%field(m)%name == 'SSH') then + allocate(segment%field(m)%buffer_dst(is_obc:ie_obc,js_obc:je_obc,1)) else allocate(segment%field(m)%buffer_dst(is_obc+1:ie_obc,js_obc:je_obc,G%ke)) endif @@ -3281,13 +3408,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) do j=js_obc+1,je_obc normal_trans_bt(I,j) = 0.0 do k=1,G%ke - segment%normal_vel(I,j,k) = segment%field(m)%buffer_dst(I,j,k) - segment%normal_trans(I,j,k) = segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & + segment%normal_vel(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k) + segment%normal_trans(I,j,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,j,k)*segment%h(I,j,k) * & G%dyCu(I,j) - normal_trans_bt(I,j) = normal_trans_bt(I,j)+segment%normal_trans(I,j,k) + normal_trans_bt(I,j) = normal_trans_bt(I,j) + segment%normal_trans(I,j,k) enddo - segment%normal_vel_bt(I,j) = normal_trans_bt(I,j)/(max(segment%Htot(I,j),1.e-12) * & - G%dyCu(I,j)) + segment%normal_vel_bt(I,j) = normal_trans_bt(I,j) / (max(segment%Htot(I,j),1.e-12) * G%dyCu(I,j)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(I,j,:) = segment%normal_vel(I,j,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_N_or_S) then @@ -3295,13 +3421,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) do i=is_obc+1,ie_obc normal_trans_bt(i,J) = 0.0 do k=1,G%ke - segment%normal_vel(i,J,k) = segment%field(m)%buffer_dst(i,J,k) - segment%normal_trans(i,J,k) = segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k) + segment%normal_trans(i,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(i,J,k)*segment%h(i,J,k) * & G%dxCv(i,J) - normal_trans_bt(i,J) = normal_trans_bt(i,J)+segment%normal_trans(i,J,k) + normal_trans_bt(i,J) = normal_trans_bt(i,J) + segment%normal_trans(i,J,k) enddo - segment%normal_vel_bt(i,J) = normal_trans_bt(i,J)/(max(segment%Htot(i,J),1.e-12) * & - G%dxCv(i,J)) + segment%normal_vel_bt(i,J) = normal_trans_bt(i,J) / (max(segment%Htot(i,J),1.e-12) * G%dxCv(i,J)) if (associated(segment%nudged_normal_vel)) segment%nudged_normal_vel(i,J,:) = segment%normal_vel(i,J,:) enddo elseif (trim(segment%field(m)%name) == 'V' .and. segment%is_E_or_W .and. & @@ -3309,7 +3434,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -3319,7 +3444,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_vel(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_vel(I,J,k) = US%m_s_to_L_T*segment%field(m)%buffer_dst(I,J,k) enddo if (associated(segment%nudged_tangential_vel)) & segment%nudged_tangential_vel(I,J,:) = segment%tangential_vel(I,J,:) @@ -3329,7 +3454,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) I=is_obc do J=js_obc,je_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo elseif (trim(segment%field(m)%name) == 'DUDY' .and. segment%is_N_or_S .and. & @@ -3337,7 +3462,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) J=js_obc do I=is_obc,ie_obc do k=1,G%ke - segment%tangential_grad(I,J,k) = segment%field(m)%buffer_dst(I,J,k) + segment%tangential_grad(I,J,k) = US%T_to_s*segment%field(m)%buffer_dst(I,J,k) enddo enddo endif @@ -3389,12 +3514,12 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) enddo ; enddo ; enddo - if (.not. segment%tr_Reg%Tr(1)%is_initialized) then + if (.not. segment%tr_Reg%Tr(2)%is_initialized) then !if the tracer reservoir has not yet been initialized, then set to external value. do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc segment%tr_Reg%Tr(2)%tres(i,j,k) = segment%tr_Reg%Tr(2)%t(i,j,k) enddo ; enddo ; enddo - segment%tr_Reg%Tr(1)%is_initialized=.true. + segment%tr_Reg%Tr(2)%is_initialized=.true. endif else segment%tr_Reg%Tr(2)%OBC_inflow_conc = segment%field(m)%value @@ -3922,7 +4047,7 @@ subroutine flood_fill2(G, color, cin, cout, cland) end subroutine flood_fill2 !> Register OBC segment data for restarts -subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) +subroutine open_boundary_register_restarts(HI, GV, OBC_CS, restart_CSp) type(hor_index_type), intent(in) :: HI !< Horizontal indices type(verticalGrid_type), pointer :: GV !< Container for vertical grid information type(ocean_OBC_type), pointer :: OBC_CS !< OBC data structure, data intent(inout) @@ -3946,21 +4071,208 @@ subroutine open_boundary_register_restarts(HI, GV, OBC_CS,restart_CSp) allocate(OBC_CS%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) OBC_CS%rx_normal(:,:,:) = 0.0 vd = var_desc("rx_normal","m s-1", "Normal Phase Speed for EW OBCs",'u','L') - call register_restart_field(OBC_CS%rx_normal, vd, .true., restart_CSp) + call register_restart_field(OBC_CS%rx_normal, vd, .false., restart_CSp) allocate(OBC_CS%ry_normal(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke)) OBC_CS%ry_normal(:,:,:) = 0.0 vd = var_desc("ry_normal","m s-1", "Normal Phase Speed for NS OBCs",'v','L') - call register_restart_field(OBC_CS%ry_normal, vd, .true., restart_CSp) + call register_restart_field(OBC_CS%ry_normal, vd, .false., restart_CSp) endif if (OBC_CS%oblique_BCs_exist_globally) then allocate(OBC_CS%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) OBC_CS%cff_normal(:,:,:) = 0.0 vd = var_desc("cff_normal","m s-1", "denominator for oblique OBCs",'q','L') - call register_restart_field(OBC_CS%cff_normal, vd, .true., restart_CSp) + call register_restart_field(OBC_CS%cff_normal, vd, .false., restart_CSp) endif end subroutine open_boundary_register_restarts +!> Update the OBC tracer reservoirs after the tracers have been updated. +subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhr !< accumulated volume/mass flux through + !! the zonal face [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhr !< accumulated volume/mass flux through + !! the meridional face [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness after advection + !! [H ~> m or kg m-2] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + real, intent(in) :: dt !< time increment [s] + type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + ! Local variables + integer :: i, j, k, m, n, ntr, nz + integer :: ishift, idir, jshift, jdir + type(OBC_segment_type), pointer :: segment=>NULL() + real :: u_L_in, u_L_out + real :: v_L_in, v_L_out + real :: fac1 + + nz = GV%ke + ntr = Reg%ntr + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + if (segment%is_E_or_W) then + do j=segment%HI%jsd,segment%HI%jed + I = segment%HI%IsdB + ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index + idir=1 ! idir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_W) then + ishift=1 + idir=-1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + do k=1,nz + u_L_in=max((idir*uhr(I,j,k))*segment%Tr_InvLscale_in/(h(i+ishift,j,k)*G%dyCu(I,j)),0.) + u_L_out=min((idir*uhr(I,j,k))*segment%Tr_InvLscale_out/(h(i+ishift,j,k)*G%dyCu(I,j)),0.) + fac1=1.0+dt*(u_L_in-u_L_out) + segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & + dt*(u_L_in*Reg%Tr(m)%t(I+ishift,j,k) - & + u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) + enddo + endif + enddo + enddo + else + do i=segment%HI%isd,segment%HI%ied + J = segment%HI%JsdB + jshift=0 ! jshift+J corresponds to the nearest interior tracer cell index + jdir=1 ! jdir switches the sign of the flow so that positive is into the reservoir + if (segment%direction == OBC_DIRECTION_S) then + jshift=1 + jdir=-1 + endif + ! update the reservoir tracer concentration implicitly + ! using Backward-Euler timestep + do m=1,ntr + if (associated(segment%tr_Reg%Tr(m)%tres)) then + do k=1,nz + v_L_in=max((jdir*vhr(i,J,k))*segment%Tr_InvLscale_in/(h(i,j+jshift,k)*G%dxCv(i,J)),0.) + v_L_out=min((jdir*vhr(i,J,k))*segment%Tr_InvLscale_out/(h(i,j+jshift,k)*G%dxCv(i,J)),0.) + fac1=1.0+dt*(v_L_in-v_L_out) + segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & + dt*(v_L_in*Reg%Tr(m)%t(i,J+jshift,k) - & + v_L_out*segment%tr_Reg%Tr(m)%t(i,J,k))) + enddo + endif + enddo + enddo + endif + enddo + endif; endif +end subroutine update_segment_tracer_reservoirs + +!> Adjust interface heights to fit the bathymetry and diagnose layer thickness. +!! +!! If the bottom most interface is below the topography then the bottom-most +!! layers are contracted to GV%Angstrom_m. +!! If the bottom most interface is above the topography then the entire column +!! is dilated (expanded) to fill the void. +!! @remark{There is a (hard-wired) "tolerance" parameter such that the +!! criteria for adjustment must equal or exceed 10cm.} +subroutine adjustSegmentEtaToFitBathymetry(G, GV, US, segment,fld) + 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(OBC_segment_type), intent(inout) :: segment !< pointer to segment type + integer, intent(in) :: fld !< field index to adjust thickness + ! Local variables + integer :: i, j, k, is, ie, js, je, nz, contractions, dilations + integer :: n + real, allocatable, dimension(:,:,:) :: eta ! Segment source data interface heights, [Z -> m] + real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] + real :: hTmp, eTmp, dilate + character(len=100) :: mesg + + hTolerance = 0.1*US%m_to_Z + + nz = size(segment%field(fld)%dz_src,3) + + if (segment%is_E_or_W) then + ! segment thicknesses are defined at cell face centers. + is = segment%HI%isdB ; ie = segment%HI%iedB + js = segment%HI%jsd ; je = segment%HI%jed + else + is = segment%HI%isd ; ie = segment%HI%ied + js = segment%HI%jsdB ; je = segment%HI%jedB + endif + allocate(eta(is:ie,js:je,nz+1)) + contractions=0; dilations=0 + do j=js,je ; do i=is,ie + eta(i,j,1)=0.0 ! segment data are assumed to be located on a static grid + ! For remapping calls, the entire column will be dilated + ! by a factor equal to the ratio of the sum of the geopotential referenced + ! source data thicknesses, and the current model thicknesses. This could be + ! an issue to be addressed, for instance if we are placing open boundaries + ! under ice shelf cavities. + do k=2,nz+1 + eta(i,j,k)=eta(i,j,k-1)-segment%field(fld)%dz_src(i,j,k-1) + enddo + ! 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) + hTolerance) then + eta(i,j,k) = -segment%Htot(i,j) + contractions = contractions + 1 + endif + enddo + + do k=1,nz + ! Collapse layers to thinnest possible if the thickness less than + ! the thinnest possible (or negative). + if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then + eta(i,j,K) = eta(i,j,K+1) + GV%Angstrom_Z + segment%field(fld)%dz_src(i,j,k) = GV%Angstrom_Z + else + segment%field(fld)%dz_src(i,j,k) = (eta(i,j,K) - eta(i,j,K+1)) + endif + enddo + + ! The whole column is dilated to accommodate deeper topography than + ! the bathymetry would indicate. + if (-eta(i,j,nz+1) < segment%Htot(i,j) - hTolerance) then + dilations = dilations + 1 + ! expand bottom-most cell only + eta(i,j,nz+1) = -segment%Htot(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 + ! else + ! dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) + ! do k=1,nz ; segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k) * dilate ; enddo + ! endif + !do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + segment%field(fld)%dz_src(i,j,k) ; enddo + endif + ! Now convert thicknesses to units of H. + do k=1,nz + segment%field(fld)%dz_src(i,j,k) = segment%field(fld)%dz_src(i,j,k)*GV%Z_to_H + enddo + enddo; enddo + + ! can not do communication call here since only PEs on the current segment are here + + ! call sum_across_PEs(contractions) + ! if ((contractions > 0) .and. (is_root_pe())) then + ! write(mesg,'("Thickness OBCs were contracted ",'// & + ! '"to fit topography in ",I8," places.")') contractions + ! call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) + ! endif + ! call sum_across_PEs(dilations) + ! if ((dilations > 0) .and. (is_root_pe())) then + ! write(mesg,'("Thickness OBCs were dilated ",'// & + ! '"to fit topography in ",I8," places.")') dilations + ! call MOM_error(WARNING, 'adjustEtaToFitBathymetry: '//mesg) + ! endif + deallocate(eta) + + + +end subroutine adjustSegmentEtaToFitBathymetry + !> \namespace mom_open_boundary !! This module implements some aspects of internal open boundary !! conditions in MOM. diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 62ac6e1ea4..045fc9261c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -9,6 +9,7 @@ module MOM_transcribe_grid use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_grid, only : ocean_grid_type, set_derived_metrics +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -18,9 +19,10 @@ module MOM_transcribe_grid !> Copies information from a dynamic (shared) horizontal grid type into an !! ocean_grid_type. -subroutine copy_dyngrid_to_MOM_grid(dG, oG) +subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) type(dyn_horgrid_type), intent(in) :: dG !< Common horizontal grid type type(ocean_grid_type), intent(inout) :: oG !< Ocean grid type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -154,16 +156,17 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG) call pass_vector(oG%Dopen_u, oG%Dopen_v, oG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_metrics(oG) + call set_derived_metrics(oG, US) end subroutine copy_dyngrid_to_MOM_grid !> Copies information from an ocean_grid_type into a dynamic (shared) !! horizontal grid type. -subroutine copy_MOM_grid_to_dyngrid(oG, dG) +subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) type(ocean_grid_type), intent(in) :: oG !< Ocean grid type type(dyn_horgrid_type), intent(inout) :: dG !< Common horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type integer :: isd, ied, jsd, jed ! Common data domains. integer :: IsdB, IedB, JsdB, JedB ! Common data domains. @@ -298,7 +301,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG) call pass_vector(dG%Dopen_u, dG%Dopen_v, dG%Domain, To_All+Scalar_Pair, CGRID_NE) endif - call set_derived_dyn_horgrid(dG) + call set_derived_dyn_horgrid(dG, US) end subroutine copy_MOM_grid_to_dyngrid diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a0b31c37de..873b0bdfb2 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -131,24 +131,24 @@ module MOM_variables v => NULL(), & !< Pointer to the meridional velocity [m s-1] h => NULL() !< Pointer to the layer thicknesses [H ~> m or kg m-2] real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Pointer to zonal transports [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL() !< Pointer to meridional transports [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Pointer to zonal transports [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL() !< Pointer to meridional transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, pointer, dimension(:,:,:) :: & - CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [m s-2] - CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [m s-2] - PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [m s-2] - PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [m s-2] - diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [m s-2] - diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [m s-2] + CAu => NULL(), & !< Pointer to the zonal Coriolis and Advective acceleration [L T-2 ~> m s-2] + CAv => NULL(), & !< Pointer to the meridional Coriolis and Advective acceleration [L T-2 ~> m s-2] + PFu => NULL(), & !< Pointer to the zonal Pressure force acceleration [L T-2 ~> m s-2] + PFv => NULL(), & !< Pointer to the meridional Pressure force acceleration [L T-2 ~> m s-2] + diffu => NULL(), & !< Pointer to the zonal acceleration due to lateral viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Pointer to the meridional acceleration due to lateral viscosity [L T-2 ~> m s-2] pbce => NULL(), & !< Pointer to the baroclinic pressure force dependency on free surface movement - !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2] - u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [m s-2] - v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [m s-2] + !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2] + u_accel_bt => NULL(), & !< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Pointer to the meridional barotropic-solver acceleration [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [m s-1] - v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [m s-1] - u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [m s-1] - v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [m s-1] + u_av => NULL(), & !< Pointer to zonal velocity averaged over the timestep [L T-1 ~> m s-1] + v_av => NULL(), & !< Pointer to meridional velocity averaged over the timestep [L T-1 ~> m s-1] + u_prev => NULL(), & !< Pointer to zonal velocity at the end of the last timestep [L T-1 ~> m s-1] + v_prev => NULL() !< Pointer to meridional velocity at the end of the last timestep [L T-1 ~> m s-1] end type ocean_internal_state !> Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances. @@ -156,16 +156,16 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [m s-2] - diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [m s-2] - CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [m s-2] - CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [m s-2] - PFu => NULL(), & !< Zonal acceleration due to pressure forces [m s-2] - PFv => NULL(), & !< Meridional acceleration due to pressure forces [m s-2] - du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [m s-2] - dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [m s-2] - du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [m s-2] - dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [m s-2] + diffu => NULL(), & !< Zonal acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] + diffv => NULL(), & !< Meridional acceleration due to along isopycnal viscosity [L T-2 ~> m s-2] + CAu => NULL(), & !< Zonal Coriolis and momentum advection accelerations [L T-2 ~> m s-2] + CAv => NULL(), & !< Meridional Coriolis and momentum advection accelerations [L T-2 ~> m s-2] + PFu => NULL(), & !< Zonal acceleration due to pressure forces [L T-2 ~> m s-2] + PFv => NULL(), & !< Meridional acceleration due to pressure forces [L T-2 ~> m s-2] + du_dt_visc => NULL(), &!< Zonal acceleration due to vertical viscosity [L T-2 ~> m s-2] + dv_dt_visc => NULL(), &!< Meridional acceleration due to vertical viscosity [L T-2 ~> m s-2] + du_dt_dia => NULL(), & !< Zonal acceleration due to diapycnal mixing [L T-2 ~> m s-2] + dv_dt_dia => NULL() !< Meridional acceleration due to diapycnal mixing [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: du_other => NULL() !< Zonal velocity changes due to any other processes that are !! not due to any explicit accelerations [m s-1]. @@ -174,10 +174,10 @@ module MOM_variables !! not due to any explicit accelerations [m s-1]. ! These accelerations are sub-terms included in the accelerations above. - real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [m s-2] - real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [m s-2] - real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [m s-2] - real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [m s-2] + real, pointer :: gradKEu(:,:,:) => NULL() !< gradKEu = - d/dx(u2) [L T-2 ~> m s-2] + real, pointer :: gradKEv(:,:,:) => NULL() !< gradKEv = - d/dy(u2) [L T-2 ~> m s-2] + real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [L T-2 ~> m s-2] + real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [L T-2 ~> m s-2] end type accel_diag_ptrs @@ -186,10 +186,10 @@ module MOM_variables ! Each of the following fields has nz layers. real, pointer, dimension(:,:,:) :: & - uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H m2 s-1 ~> m3 s-1 or kg s-1] - uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] - vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H m2 s-1 ~> m3 s-1 or kg s-1] + uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] + vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] ! Each of the following fields is found at nz+1 interfaces. real, pointer :: diapyc_vel(:,:,:) => NULL() !< The net diapycnal velocity [H s-1 ~> m s-1 or kg m-2 s-1] @@ -203,9 +203,9 @@ module MOM_variables real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points [Z ~> m]. bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 s-1 ~> m2 s-1]. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 s-1 ~> m2 s-1]. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< 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 @@ -218,9 +218,9 @@ module MOM_variables real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() !< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m]. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 s-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 s-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< 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 @@ -231,31 +231,31 @@ module MOM_variables real, pointer, dimension(:,:) :: & MLD => NULL() !< Instantaneous active mixing layer depth [H ~> m or kg m-2]. real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z s-1 ~> m s-1]. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z s-1 ~> m s-1]. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density [Z2 s-1 ~> m2 s-1]. + !! diffusivity of density [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density [Z2 s-1 ~> m2 s-1]. + !! diffusivity of density [Z2 T-1 ~> m2 s-1]. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns [Z2 s-1 ~> m2 s-1]. + !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns [Z2 s-1 ~> m2 s-1]. + !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns [Z2 s-1 ~> m2 s-1]. + !! corner columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc) [Z2 s-1 ~> m2 s-1]. + !! background, convection etc) [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() - !< The turbulent kinetic energy per unit mass at the interfaces [m2 s-2]. + !< 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 end type vertvisc_type @@ -263,28 +263,28 @@ module MOM_variables !! and how they will vary as the barotropic velocity is changed. type, public :: BT_cont_type real, allocatable :: FA_u_EE(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the east [H m ~> m2 or kg m-1]. + !! drawing from locations far to the east [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_E0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the east [H m ~> m2 or kg m-1]. + !! drawing from nearby to the east [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_W0(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from nearby to the west [H m ~> m2 or kg m-1]. + !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport - !! drawing from locations far to the west [H m ~> m2 or kg m-1]. - real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [m s-1], beyond which the marginal + !! drawing from locations far to the west [H L ~> m2 or kg m-1]. + real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_WW. uBT_WW must be non-negative. - real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [m s-1], beyond which the marginal + real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the north [H m ~> m2 or kg m-1]. + !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the north [H m ~> m2 or kg m-1]. + !! drawing from nearby to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_S0(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from nearby to the south [H m ~> m2 or kg m-1]. + !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport - !! drawing from locations far to the south [H m ~> m2 or kg m-1]. - real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [m s-1], beyond which the marginal + !! drawing from locations far to the south [H L ~> m2 or kg m-1]. + real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_SS. vBT_SS must be non-negative. - real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [m s-1], beyond which the marginal + real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal !! open face area is FA_v_NN. vBT_NN must be non-positive. real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 83fb6d9268..c11de0d0dd 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -26,7 +26,8 @@ module MOM_verticalGrid ! Commonly used parameters integer :: ke !< The number of layers/levels in the vertical real :: max_depth !< The maximum depth of the ocean [Z ~> m]. - real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. + real :: mks_g_Earth !< The gravitational acceleration in unscaled MKS units [m s-2]. + real :: g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units [kg m-3]. @@ -47,7 +48,7 @@ module MOM_verticalGrid !! Angstrom or larger without changing it at the bit level [H ~> m or kg m-2]. !! If Angstrom is 0 or exceedingly small, this is negligible compared to 1e-17 m. real, allocatable, dimension(:) :: & - g_prime, & !< The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. + g_prime, & !< The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. Rlay !< The target coordinate value (potential density) in each layer [kg m-3]. integer :: nkml = 0 !< The number of layers at the top that should be treated !! as parts of a homogeneous region. @@ -88,7 +89,7 @@ subroutine verticalGridInit( param_file, GV, US ) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & "Parameters providing information about the vertical grid.") - call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & + call get_param(param_file, mdl, "G_EARTH", GV%mks_g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & @@ -122,7 +123,7 @@ subroutine verticalGridInit( param_file, GV, US ) "units of thickness into m.", units="m H-1", default=1.0) GV%H_to_m = GV%H_to_m * H_rescale_factor endif - GV%g_Earth = GV%g_Earth * US%Z_to_m + GV%g_Earth = US%m_to_L**2*US%Z_to_m*US%T_to_s**2 * GV%mks_g_Earth #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -149,7 +150,7 @@ subroutine verticalGridInit( param_file, GV, US ) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = (GV%g_Earth*US%m_to_Z) * GV%H_to_kg_m2 + GV%H_to_Pa = GV%mks_g_Earth * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 9c2f0b6adf..e0bbd832bb 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -47,18 +47,18 @@ module MOM_PointAccel ! that are used to step the physical model forward. They all use the same ! names as the variables they point to in MOM.F90 real, pointer, dimension(:,:,:) :: & - u_av => NULL(), & !< Time average u-velocity [m s-1]. - v_av => NULL(), & !< Time average velocity [m s-1]. - u_prev => NULL(), & !< Previous u-velocity [m s-1]. - v_prev => NULL(), & !< Previous v-velocity [m s-1]. + u_av => NULL(), & !< Time average u-velocity [L T-1 ~> m s-1]. + v_av => NULL(), & !< Time average velocity [L T-1 ~> m s-1]. + u_prev => NULL(), & !< Previous u-velocity [L T-1 ~> m s-1]. + v_prev => NULL(), & !< Previous v-velocity [L T-1 ~> m s-1]. T => NULL(), & !< Temperature [degC]. S => NULL(), & !< Salinity [ppt]. - u_accel_bt => NULL(), & !< Barotropic u-acclerations [m s-2] - v_accel_bt => NULL() !< Barotropic v-acclerations [m s-2] + u_accel_bt => NULL(), & !< Barotropic u-acclerations [L T-2 ~> m s-2] + v_accel_bt => NULL() !< Barotropic v-acclerations [L T-2 ~> m s-2] real, pointer, dimension(:,:,:) :: pbce => NULL() !< pbce times eta gives the baroclinic !! pressure anomaly in each layer due to free surface height anomalies !! [m2 s-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - + real :: u_av_scale !< A scaling factor to convert u_av to m s-1. end type PointAccel_CS contains @@ -73,7 +73,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: um !< The new zonal velocity [m s-1]. + intent(in) :: um !< The new zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -83,7 +83,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. + 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 integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -132,14 +132,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! Determine which layers to write out accelerations for. do k=1,nz - if (((max(CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k),um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & - (min(CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%u_av(I,j,k), um(I,j,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -163,54 +163,54 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo write(file,'(/,"u(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (um(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*um(I,j,k)); enddo if (prev_avail) then write(file,'(/,"u(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_prev(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%u_prev(I,j,k)); enddo endif write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%u_av(I,j,k)); enddo write(file,'(/,"CFL u: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) + CFL = abs(um(I,j,k)) * US%s_to_T*dt * G%dy_Cu(I,j) if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 u:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo + abs(um(I,j,k)) * US%s_to_T*dt * G%IdxCu(I,j) ; enddo if (prev_avail) then write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))); enddo + (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))); enddo endif write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)); enddo write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)); enddo write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%diffu(I,j,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEu(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)); enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"ubv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (um(I,j,k)-dt*ADp%du_dt_visc(I,j,k)); enddo + US%L_T_to_m_s*(um(I,j,k) - US%s_to_T*dt*ADp%du_dt_visc(I,j,k)); enddo write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%du_dt_visc(I,j,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k)); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -230,7 +230,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'("dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%u_accel_bt(I,j,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif @@ -285,10 +285,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo + (uh_scale*US%m_to_L*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)); enddo write(file,'(/," vhC--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,j-1,k)*h_scale*(hin(i,j-1,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -297,10 +297,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo + (uh_scale*US%m_to_L*CDp%vh(i,J,k)*G%IdxCv(i,J)); enddo write(file,'(/," vhC-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i,J,k)*h_scale*(hin(i,j,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -309,10 +309,10 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo + (uh_scale*US%m_to_L*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)); enddo write(file,'(/," vhC+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J-1,k)*h_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," vhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -321,14 +321,14 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"vh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo + (uh_scale*US%m_to_L*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)); enddo write(file,'(/," vhC++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," vhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (0.5*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo + (0.5*CS%u_av_scale*CS%v_av(i+1,J,k)*h_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))); enddo endif write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*G%bathyT(i,j),US%Z_to_m*G%bathyT(i+1,j) @@ -336,7 +336,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - du = um(I,j,k)-CS%u_prev(I,j,k) + du = US%L_T_to_m_s*(um(I,j,k) - CS%u_prev(I,j,k)) if (abs(du) < 1.0e-6) du = 1.0e-6 Inorm(k) = 1.0 / du enddo @@ -346,34 +346,34 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"du: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo + (US%L_T_to_m_s*(um(I,j,k)-CS%u_prev(I,j,k))*Inorm(k)); enddo write(file,'(/,"CAu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAu(I,j,k)*Inorm(k)); enddo write(file,'(/,"PFu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFu(I,j,k)*Inorm(k)); enddo write(file,'(/,"diffu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%diffu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%diffu(I,j,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEu: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEu(I,j,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEu(I,j,k)*Inorm(k)); enddo endif if (associated(ADp%rv_x_v)) then write(file,'(/,"Coru: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_dt_visc)) then write(file,'(/,"duv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo + (dt*US%L_T2_to_m_s2*ADp%du_dt_visc(I,j,k))*Inorm(k); enddo endif if (associated(ADp%du_other)) then write(file,'(/,"du_other: ",$)') @@ -383,7 +383,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%u_accel_bt)) then write(file,'(/,"dubt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%u_accel_bt(I,j,k)*Inorm(k)) ; enddo endif endif @@ -404,7 +404,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st 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),SZJB_(G),SZK_(G)), & - intent(in) :: vm !< The new meridional velocity [m s-1]. + intent(in) :: vm !< The new meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: hin !< The layer thickness [H ~> m or kg m-2]. type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various @@ -414,7 +414,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: dt !< The ocean dynamics time step [s]. type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous !! call to PointAccel_init. - real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [m s-1]. + 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 integrated over a time !! step divided by the Boussinesq density [m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -462,14 +462,14 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st prev_avail = (associated(CS%u_prev) .and. associated(CS%v_prev)) do k=1,nz - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ks = k do k=nz,1,-1 - if (((max(CS%v_av(i,J,k), vm(i,J,k)) >= vel_rpt) .or. & - (min(CS%v_av(i,J,k), vm(i,J,k)) <= -vel_rpt)) .and. & + if (((max(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) >= vel_rpt) .or. & + (min(US%m_s_to_L_T*CS%u_av_scale*CS%v_av(i,J,k), US%L_T_to_m_s*vm(i,J,k)) <= -vel_rpt)) .and. & ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom)) exit enddo ke = k @@ -493,59 +493,59 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"Layers:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k); enddo write(file,'(/,"v(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vm(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*vm(i,J,k)); enddo if (prev_avail) then write(file,'(/,"v(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_prev(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%L_T_to_m_s*CS%v_prev(i,J,k)); enddo endif write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%v_av(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (CS%u_av_scale*CS%v_av(i,J,k)); enddo write(file,'(/,"CFL v: ",$)') do k=ks,ke ; if (do_k(k)) then - CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) + CFL = abs(vm(i,J,k)) * US%s_to_T*dt * G%dx_Cv(i,J) if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) else ; CFL = CFL * G%IareaT(i,j) ; endif write(file,'(ES10.3," ",$)') CFL endif ; enddo write(file,'(/,"CFL0 v:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo + abs(vm(i,J,k)) * US%s_to_T*dt * G%IdyCv(i,J) ; enddo if (prev_avail) then write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))); enddo + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))); enddo endif write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%CAv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)); enddo write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%PFv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)); enddo write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*ADp%diffv(i,J,k)); enddo + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)); enddo if (associated(ADp%gradKEv)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%gradKEv(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)); enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"vbv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (vm(i,J,k)-dt*ADp%dv_dt_visc(i,J,k)); enddo + US%L_T_to_m_s*(vm(i,J,k) - US%s_to_T*dt*ADp%dv_dt_visc(i,J,k)); enddo write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') @@ -565,7 +565,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'("dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (dt*CS%v_accel_bt(i,J,k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif @@ -619,10 +619,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo + (uh_scale*US%m_to_L*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)); enddo write(file,'(/," uhC--: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j,k) * h_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp--:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -631,10 +631,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo + (uh_scale*US%m_to_L*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)); enddo write(file,'(/," uhC-+: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo + (CS%u_av_scale*CS%u_av(I-1,j+1,k) * h_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp-+:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -643,10 +643,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo + (uh_scale*US%m_to_L*CDp%uh(I,j,k)*G%IdyCu(I,j)); enddo write(file,'(/," uhC+-: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo + (CS%u_av_scale*CS%u_av(I,j,k) * h_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))); enddo if (prev_avail) then write(file,'(/," uhCp+-:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -655,10 +655,10 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st write(file,'(/,"uh++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo + (uh_scale*US%m_to_L*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)); enddo write(file,'(/," uhC++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & - (CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo + (CS%u_av_scale*CS%u_av(I,j+1,k) * 0.5*h_scale*(hin(i,j+1,k) + hin(i+1,j+1,k))); enddo if (prev_avail) then write(file,'(/," uhCp++:",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & @@ -670,7 +670,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st ! From here on, the normalized accelerations are written. if (prev_avail) then do k=ks,ke - dv = vm(i,J,k)-CS%v_prev(i,J,k) + dv = US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k)) if (abs(dv) < 1.0e-6) dv = 1.0e-6 Inorm(k) = 1.0 / dv enddo @@ -679,31 +679,31 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (1.0/Inorm(k)); enddo write(file,'(/,"dv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - ((vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo + (US%L_T_to_m_s*(vm(i,J,k)-CS%v_prev(i,J,k))*Inorm(k)); enddo write(file,'(/,"CAv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%CAv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%CAv(i,J,k)*Inorm(k)); enddo write(file,'(/,"PFv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%PFv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%PFv(i,J,k)*Inorm(k)); enddo write(file,'(/,"diffv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%diffv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%diffv(i,J,k)*Inorm(k)); enddo if (associated(ADp%gradKEu)) then write(file,'(/,"KEv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%gradKEv(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%gradKEv(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%rv_x_u)) then write(file,'(/,"Corv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo + dt*US%L_T2_to_m_s2*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k))*Inorm(k); enddo endif if (associated(ADp%dv_dt_visc)) then write(file,'(/,"dvv: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo + (dt*US%L_T2_to_m_s2*ADp%dv_dt_visc(i,J,k)*Inorm(k)); enddo endif if (associated(ADp%dv_other)) then write(file,'(/,"dv_other: ",$)') @@ -713,7 +713,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if (associated(CS%v_accel_bt)) then write(file,'(/,"dvbt: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & - (dt*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo + (dt*US%L_T2_to_m_s2*CS%v_accel_bt(i,J,k)*Inorm(k)) ; enddo endif endif @@ -755,6 +755,9 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_av => MIS%u_av; if (.not.associated(MIS%u_av)) CS%u_av => MIS%u(:,:,:) CS%v_av => MIS%v_av; if (.not.associated(MIS%v_av)) CS%v_av => MIS%v(:,:,:) +! CS%u_av_scale = G%US%L_T_to_m_s ; if (.not.associated(MIS%u_av)) CS%u_av_scale = 1.0 + CS%u_av_scale = 1.0 + ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 45cfb0ac68..54025a0ac0 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -66,8 +66,8 @@ module MOM_diagnostics ! following fields have nz layers. real, pointer, dimension(:,:,:) :: & - du_dt => NULL(), & !< net i-acceleration [m s-2] - dv_dt => NULL(), & !< net j-acceleration [m s-2] + du_dt => NULL(), & !< net i-acceleration [L T-1 s-1 ~> m s-2] + dv_dt => NULL(), & !< net j-acceleration [L T-1 s-1 ~> m s-2] dh_dt => NULL(), & !< thickness rate of change [H s-1 ~> m s-1 or kg m-2 s-1] p_ebt => NULL() !< Equivalent barotropic modal structure [nondim] @@ -188,17 +188,17 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces = u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through meridional faces = v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to @@ -251,6 +251,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = G%ke ; nkmb = GV%nk_rho_varies + if (loc(CS)==0) call MOM_error(FATAL, & + "calculate_diagnostic_fields: Module must be initialized before used.") + + call calculate_derivs(dt, G, CS) + if (dt > 0.0) then call diag_save_grids(CS%diag) call diag_copy_storage_to_diag(CS%diag, diag_pre_sync) @@ -266,7 +271,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call diag_restore_grids(CS%diag) - call calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) + call calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS) endif ! smg: is the following robust to ALE? It seems a bit opaque. @@ -275,12 +280,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! nkmb = nz, on the expectation that loops nkmb+1,nz will not iterate. ! This behavior is ANSI F77 but some compiler options can force at least ! one iteration that would break the following one-line workaround! - if (nkmb==0) nkmb = nz - - if (loc(CS)==0) call MOM_error(FATAL, & - "calculate_diagnostic_fields: Module must be initialized before used.") - - call calculate_derivs(dt, G, CS) + if (nkmb==0 .and. nz > 1) nkmb = nz if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) @@ -320,7 +320,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_masso > 0) then work_2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * G%areaT(i,j) + work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo masso = reproducing_sum(work_2d) call post_data(CS%id_masso, masso, CS%diag) @@ -339,7 +339,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif ; endif if (CS%id_volcello > 0) then ! volcello = h*area for Boussinesq do k=1,nz; do j=js,je ; do i=is,ie - work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * G%areaT(i,j) + work_3d(i,j,k) = ( GV%H_to_m*h(i,j,k) ) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -372,7 +372,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_thkcello > 0) call post_data(CS%id_thkcello, work_3d, CS%diag) if (CS%id_volcello > 0) then do k=1,nz; do j=js,je ; do i=is,ie ! volcello = dp/(rho*g)*area for non-Boussinesq - work_3d(i,j,k) = G%areaT(i,j) * work_3d(i,j,k) + work_3d(i,j,k) = US%L_to_m**2*G%areaT(i,j) * work_3d(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_volcello, work_3d, CS%diag) endif @@ -558,7 +558,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & enddo ; enddo enddo - if (CS%id_uh_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) + if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) endif if (associated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then @@ -629,7 +629,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * sqrt(0.5 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -641,19 +641,19 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CS%cfl_cg1(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CS%cfl_cg1_x(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdxT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CS%cfl_cg1_y(i,j) = (dt*US%m_to_L*CS%cg1(i,j)) * G%IdyT(i,j) enddo ; enddo call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) endif @@ -678,7 +678,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & f2_h = absurdly_small_freq2 + 0.25 * US%s_to_T**2 * & ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) - mag_beta = sqrt(0.5 * US%s_to_T**2 * ( & + mag_beta = US%s_to_T*US%m_to_L * sqrt(0.5 * ( & (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -832,7 +832,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) do j=js,je ; do i=is,ie ; mass(i,j) = 0.0 ; enddo ; enddo if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then - IG_Earth = 1.0 / (GV%g_Earth*US%m_to_Z) + IG_Earth = 1.0 / GV%mks_g_Earth ! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=js,je ; do i=is,ie ; z_bot(i,j) = 0.0 ; enddo ; enddo do k=1,nz @@ -841,7 +841,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) z_bot(i,j) = z_top(i,j) - GV%H_to_Z*h(i,j,k) enddo ; enddo call int_density_dz(tv%T(:,:,k), tv%S(:,:,k), & - z_top, z_bot, 0.0, GV%Rho0, GV%g_Earth, & + z_top, z_bot, 0.0, GV%Rho0, GV%mks_g_Earth*US%Z_to_m, & G%HI, G%HI, tv%eqn_of_state, dpress) do j=js,je ; do i=is,ie mass(i,j) = mass(i,j) + dpress(i,j) * IG_Earth @@ -866,7 +866,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * (GV%g_Earth*US%m_to_Z) + btm_pres(i,j) = mass(i,j) * GV%mks_g_Earth if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif @@ -878,23 +878,24 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) end subroutine calculate_vertical_integrals !> This subroutine calculates terms in the mechanical energy budget. -subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) +subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, 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. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: uh !< Transport through zonal faces=u*h*dy, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(in) :: vh !< Transport through merid faces=v*h*dx, - !! [H m2 s-1 ~> m3 s-1 or kg s-1]. + !! [H L2 T-1 ~> m3 s-1 or kg s-1]. type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to accelerations in momentum equation. type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms in continuity equations. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to !! diagnostics_init. @@ -915,7 +916,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%KE)) then do k=1,nz ; do j=js,je ; do i=is,ie - CS%KE(i,j,k) = ((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & + CS%KE(i,j,k) = US%L_T_to_m_s**2*((u(I,j,k)*u(I,j,k) + u(I-1,j,k)*u(I-1,j,k)) + & (v(i,J,k)*v(i,J,k) + v(i,J-1,k)*v(i,J-1,k)))*0.25 ! DELETE THE FOLLOWING... Make this 0 to test the momentum balance, ! or a huge number to test the continuity balance. @@ -935,13 +936,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%dKE_dt)) then 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) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*CS%du_dt(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k)*CS%dh_dt(i,j,k) + KE_h(i,j) = CS%KE(i,j,k)*US%s_to_T*CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -956,10 +957,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%PE_to_KE)) then 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) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%PFu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%PFv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -974,14 +975,14 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%KE_CorAdv)) then 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%CAu(I,j,k) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%CAu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -994,16 +995,22 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) endif if (associated(CS%KE_adv)) then + ! NOTE: All terms in KE_adv are multipled 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. + KE_u(:,:) = 0. ; KE_v(:,:) = 0. 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%gradKEu(I,j,k) + if (G%mask2dCu(i,j) /= 0.) & + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%gradKEu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) + if (G%mask2dCv(i,j) /= 0.) & + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%gradKEv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) * & - (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) + US%s_to_T*(uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1018,10 +1025,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%KE_visc)) then 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) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_visc(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_visc(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1036,10 +1043,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%KE_horvisc)) then 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) + KE_u(I,j) = US%s_to_T*uh(I,j,k)*US%L_to_m*G%dxCu(I,j)*US%L_T2_to_m_s2*ADp%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%diffv(i,J,k) + KE_v(i,J) = US%s_to_T*vh(i,J,k)*US%L_to_m*G%dyCv(i,J)*US%L_T2_to_m_s2*ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) @@ -1054,10 +1061,10 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, CS) if (associated(CS%KE_dia)) then 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) + KE_u(I,j) = US%L_T_to_m_s**2*US%s_to_T*uh(I,j,k)*G%dxCu(I,j)*ADp%du_dt_dia(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - KE_v(i,J) = vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) + KE_v(i,J) = US%L_T_to_m_s**2*US%s_to_T*vh(i,J,k)*G%dyCv(i,J)*ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie KE_h(i,j) = CS%KE(i,j,k) * & @@ -1116,14 +1123,14 @@ end subroutine register_time_deriv !> This subroutine calculates all registered time derivatives. subroutine calculate_derivs(dt, G, CS) - real, intent(in) :: dt !< The time interval over which differences occur [s]. + real, intent(in) :: dt !< The time interval over which differences occur [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. ! This subroutine calculates all registered time derivatives. - integer i, j, k, m - real Idt + real :: Idt ! The inverse timestep [T-1 ~> s-1] + integer :: i, j, k, m if (dt > 0.0) then ; Idt = 1.0/dt else ; return ; endif @@ -1328,14 +1335,15 @@ end subroutine post_surface_thermo_diags !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & +subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dyn, & diag, dt_trans, Reg) type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< Accumulated zonal thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< Accumulated meridional thickness fluxes - !! used to advect tracers [H m2 ~> m3 or kg] + !! used to advect tracers [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< The updated layer thicknesses [H ~> m or kg m-2] type(transport_diag_IDs), intent(in) :: IDs !< A structure with the diagnostic IDs. @@ -1353,12 +1361,12 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, & ! [H s-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [s-1] real :: H_to_kg_m2_dt ! A conversion factor from accumulated transports to fluxes - ! [kg m-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. + ! [kg L-2 H-1 s-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Idt = 1. / dt_trans - H_to_kg_m2_dt = GV%H_to_kg_m2 * Idt + H_to_kg_m2_dt = GV%H_to_kg_m2 * US%L_to_m**2 * Idt call diag_save_grids(diag) call diag_copy_storage_to_diag(diag, diag_pre_dyn) @@ -1536,10 +1544,10 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & - 'Zonal velocity', 'm s-1', cmor_field_name='uo', & + 'Zonal velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='uo', & cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & - 'Meridional velocity', 'm s-1', cmor_field_name='vo', & + 'Meridional velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='vo', & cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') CS%id_h = register_diag_field('ocean_model', 'h', diag%axesTL, Time, & 'Layer Thickness', thickness_units, v_extensive=.true., conversion=convert_H) @@ -1566,21 +1574,21 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'In situ density', 'kg m-3') CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & - 'Zonal Acceleration', 'm s-2') + 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_du_dt>0) .and. .not.associated(CS%du_dt)) then call safe_alloc_ptr(CS%du_dt,IsdB,IedB,jsd,jed,nz) call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & - 'Meridional Acceleration', 'm s-2') + 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) if ((CS%id_dv_dt>0) .and. .not.associated(CS%dv_dt)) then call safe_alloc_ptr(CS%dv_dt,isd,ied,JsdB,JedB,nz) call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & - 'Thickness tendency', trim(thickness_units)//" s-1", v_extensive = .true.) + 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) if ((CS%id_dh_dt>0) .and. .not.associated(CS%dh_dt)) then call safe_alloc_ptr(CS%dh_dt,isd,ied,jsd,jed,nz) call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) @@ -1595,22 +1603,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', flux_units, & - conversion=convert_H) + conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_uh_Rlay>0) call safe_alloc_ptr(CS%uh_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', flux_units, & - conversion=convert_H) + conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_vh_Rlay>0) call safe_alloc_ptr(CS%vh_Rlay,isd,ied,JsdB,JedB,nz) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & - 'Zonal volume transport due to interface height diffusion in pure potential & - &density coordinates', flux_units, conversion=convert_H) + 'Zonal volume transport due to interface height diffusion in pure potential '//& + 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_uhGM_Rlay>0) call safe_alloc_ptr(CS%uhGM_Rlay,IsdB,IedB,jsd,jed,nz) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & - 'Meridional volume transport due to interface height diffusion in pure & - &potential density coordinates', flux_units, conversion=convert_H) + 'Meridional volume transport due to interface height diffusion in pure potential '//& + 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) if (CS%id_vhGM_Rlay>0) call safe_alloc_ptr(CS%vhGM_Rlay,isd,ied,JsdB,JedB,nz) !endif @@ -1785,10 +1793,11 @@ subroutine register_surface_diags(Time, G, IDs, diag, tv) end subroutine register_surface_diags !> Register certain diagnostics related to transports -subroutine register_transport_diags(Time, G, GV, IDs, diag) +subroutine register_transport_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time 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 type(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output @@ -1805,10 +1814,10 @@ subroutine register_transport_diags(Time, G, GV, IDs, diag) ! Diagnostics related to tracer and mass transport IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg', & - y_cell_method='sum', v_extensive=.true., conversion=H_convert) + y_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg', & - x_cell_method='sum', v_extensive=.true., conversion=H_convert) + x_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) IDs%id_umo = register_diag_field('ocean_model', 'umo', & diag%axesCuL, Time, 'Ocean Mass X Transport', 'kg s-1', & standard_name='ocean_mass_x_transport', y_cell_method='sum', v_extensive=.true.) @@ -1874,7 +1883,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%geoLonCu, diag, .true.) id = register_static_field('ocean_model', 'area_t', diag%axesT1, & - 'Surface area of tracer (T) cells', 'm2', & + 'Surface area of tracer (T) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') @@ -1884,21 +1893,21 @@ subroutine write_static_fields(G, GV, US, tv, diag) endif id = register_static_field('ocean_model', 'area_u', diag%axesCu1, & - 'Surface area of x-direction flow (U) cells', 'm2', & + 'Surface area of x-direction flow (U) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCu, diag, .true.) id = register_static_field('ocean_model', 'area_v', diag%axesCv1, & - 'Surface area of y-direction flow (V) cells', 'm2', & + 'Surface area of y-direction flow (V) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_cv', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaCv, diag, .true.) id = register_static_field('ocean_model', 'area_q', diag%axesB1, & - 'Surface area of B-grid flow (Q) cells', 'm2', & + 'Surface area of B-grid flow (Q) cells', 'm2', conversion=US%m_to_L**2, & cmor_field_name='areacello_bu', cmor_standard_name='cell_area', & cmor_long_name='Ocean Grid-Cell Area', & x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') @@ -1934,35 +1943,35 @@ subroutine write_static_fields(G, GV, US, tv, diag) if (id > 0) call post_data(id, G%CoriolisBu, diag, .true.) id = register_static_field('ocean_model', 'dxt', diag%axesT1, & - 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dxt, diag, .true.) + 'Delta(x) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dxT, diag, .true.) id = register_static_field('ocean_model', 'dyt', diag%axesT1, & - 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none') - if (id > 0) call post_data(id, G%dyt, diag, .true.) + 'Delta(y) at thickness/tracer points (meter)', 'm', interp_method='none', conversion=US%L_to_m) + if (id > 0) call post_data(id, G%dyT, diag, .true.) id = register_static_field('ocean_model', 'dxCu', diag%axesCu1, & - 'Delta(x) at u points (meter)', 'm', interp_method='none') + 'Delta(x) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCu, diag, .true.) id = register_static_field('ocean_model', 'dyCu', diag%axesCu1, & - 'Delta(y) at u points (meter)', 'm', interp_method='none') + 'Delta(y) at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCu, diag, .true.) id = register_static_field('ocean_model', 'dxCv', diag%axesCv1, & - 'Delta(x) at v points (meter)', 'm', interp_method='none') + 'Delta(x) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dxCv, diag, .true.) id = register_static_field('ocean_model', 'dyCv', diag%axesCv1, & - 'Delta(y) at v points (meter)', 'm', interp_method='none') + 'Delta(y) at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dyCv, diag, .true.) id = register_static_field('ocean_model', 'dyCuo', diag%axesCu1, & - 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none') + 'Open meridional grid spacing at u points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dy_Cu, diag, .true.) id = register_static_field('ocean_model', 'dxCvo', diag%axesCv1, & - 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none') + 'Open zonal grid spacing at v points (meter)', 'm', interp_method='none', conversion=US%L_to_m) if (id > 0) call post_data(id, G%dx_Cv, diag, .true.) id = register_static_field('ocean_model', 'sin_rot', diag%axesT1, & diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 4062d04fd9..1f674290d3 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -165,6 +165,9 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "RINO_CRIT_EQ") call obsolete_real(param_file, "SHEARMIX_RATE_EQ") + call obsolete_real(param_file, "VSTAR_SCALE_FACTOR", hint="Use EPBL_VEL_SCALE_FACTOR instead.") + call obsolete_logical(param_file, "ORIG_MLD_ITERATION", .false.) + call obsolete_logical(param_file, "CONTINUITY_PPM", .true.) call obsolete_logical(param_file, "USE_LOCAL_PREF", .true.) @@ -206,6 +209,7 @@ subroutine find_obsolete_params(param_file) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") + call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 9399f73a58..d6f495faa5 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -305,9 +305,9 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various @@ -387,6 +387,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & Temp_int, Salt_int ! Layer and cell integrated heat and salt [J] and [g Salt]. real :: H_to_kg_m2 ! Local copy of a unit conversion factor. + real :: KE_scale_factor ! The combination of unit rescaling factors in the kinetic energy + ! calculation [kg T2 L-2 s-2 H-1 ~> kg m-3 or nondim] integer :: num_nc_fields ! The number of fields that will actually go into ! the NetCDF file. integer :: i, j, k, is, ie, js, je, ns, nz, m, Isq, Ieq, Jsq, Jeq @@ -483,7 +485,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ "write_energy: Module must be initialized before it is used.") do j=js,je ; do i=is,ie - areaTm(i,j) = G%mask2dT(i,j)*G%areaT(i,j) + areaTm(i,j) = G%mask2dT(i,j)*US%L_to_m**2*G%areaT(i,j) enddo ; enddo if (GV%Boussinesq) then @@ -664,7 +666,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) hbot = Z_0APE(K) - G%bathyT(i,j) hbot = (hbot + ABS(hbot)) * 0.5 - PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*(GV%Rho0*GV%g_prime(K)) * & + PE_pt(i,j,K) = 0.5 * areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -673,7 +675,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ 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), 0.0) - PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*(GV%Rho0*GV%g_prime(K))) * & + PE_pt(i,j,K) = 0.5 * (areaTm(i,j) * US%Z_to_m*US%L_T_to_m_s**2*(GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo enddo ; enddo @@ -687,9 +689,10 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif ! Calculate the Kinetic Energy integrated over each layer. + KE_scale_factor = GV%H_to_kg_m2*US%L_T_to_m_s**2 tmp1(:,:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = (0.25 * H_to_kg_m2 * (areaTm(i,j) * h(i,j,k))) * & + tmp1(i,j,k) = (0.25 * KE_scale_factor * (areaTm(i,j) * h(i,j,k))) * & (u(I-1,j,k)**2 + u(I,j,k)**2 + v(i,J-1,k)**2 + v(i,J,k)**2) enddo ; enddo ; enddo KE_tot = reproducing_sum(tmp1, sums=KE) @@ -713,21 +716,21 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ max_CFL(1:2) = 0.0 do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (u(I,j,k) < 0.0) then - CFL_trans = (-u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL_trans = (-u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL_trans = (u(I,j,k) * CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL_trans = (u(I,j,k) * US%s_to_T*CS%dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif - CFL_lin = abs(u(I,j,k) * CS%dt) * G%IdxCu(I,j) + CFL_lin = abs(u(I,j,k) * US%s_to_T*CS%dt) * G%IdxCu(I,j) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (v(i,J,k) < 0.0) then - CFL_trans = (-v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL_trans = (-v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL_trans = (v(i,J,k) * CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL_trans = (v(i,J,k) * US%s_to_T*CS%dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif - CFL_lin = abs(v(i,J,k) * CS%dt) * G%IdyCv(i,J) + CFL_lin = abs(v(i,J,k) * US%s_to_T*CS%dt) * G%IdyCv(i,J) max_CFL(1) = max(max_CFL(1), CFL_trans) max_CFL(2) = max(max_CFL(2), CFL_lin) enddo ; enddo ; enddo @@ -818,7 +821,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ endif if (CS%use_temperature) then - write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES18.12, & + write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES22.16, & &", CFL ", F8.5, ", SL ",& &es11.4,", M ",ES11.5,", S",f8.4,", T",f8.4,& &", Me ",ES9.2,", Se ",ES9.2,", Te ",ES9.2)') & @@ -826,7 +829,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ -H_0APE(1), mass_tot, salin, temp, mass_anom/mass_tot, salin_anom, & temp_anom else - write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES18.12, & + write(CS%fileenergy_ascii,'(A,",",A,",", I6,", En ",ES22.16, & &", CFL ", F8.5, ", SL ",& &ES11.4,", Mass ",ES11.5,", Me ",ES9.2)') & trim(n_str), trim(day_str), CS%ntrunc, En_mass, max_CFL(1), & @@ -972,7 +975,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) if (associated(fluxes%evap)) then if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then do j=js,je ; do i=is,ie - FW_in(i,j) = dt*G%areaT(i,j)*(fluxes%evap(i,j) + & + FW_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(fluxes%evap(i,j) + & (((fluxes%lprec(i,j) + fluxes%vprec(i,j)) + fluxes%lrunoff(i,j)) + & (fluxes%fprec(i,j) + fluxes%frunoff(i,j)))) enddo ; enddo @@ -983,25 +986,25 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) endif if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie - FW_in(i,j) = FW_in(i,j) + dt * G%areaT(i,j) * fluxes%seaice_melt(i,j) + FW_in(i,j) = FW_in(i,j) + dt * G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt(i,j) enddo ; enddo ; endif salt_in(:,:) = 0.0 ; heat_in(:,:) = 0.0 if (CS%use_temperature) then if (associated(fluxes%sw)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * (fluxes%sw(i,j) + & + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * (fluxes%sw(i,j) + & (fluxes%lw(i,j) + (fluxes%latent(i,j) + fluxes%sens(i,j)))) enddo ; enddo ; endif if (associated(fluxes%seaice_melt_heat)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * fluxes%seaice_melt_heat(i,j) enddo ; enddo ; endif ! smg: new code ! include heat content from water transport across ocean surface ! if (associated(fluxes%heat_content_lprec)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j) * & +! heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j) * & ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) & ! + (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) & ! + (fluxes%heat_content_cond(i,j) + (fluxes%heat_content_vprec(i,j) & @@ -1011,7 +1014,7 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! smg: old code if (associated(sfc_state%TempxPmE)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * sfc_state%TempxPmE(i,j) + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * sfc_state%TempxPmE(i,j) enddo ; enddo elseif (associated(fluxes%evap)) then do j=js,je ; do i=is,ie @@ -1023,23 +1026,23 @@ subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) ! The following heat sources may or may not be used. if (associated(sfc_state%internal_heat)) then do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + (C_p * G%areaT(i,j)) * & + heat_in(i,j) = heat_in(i,j) + (C_p * G%US%L_to_m**2*G%areaT(i,j)) * & sfc_state%internal_heat(i,j) enddo ; enddo endif if (associated(sfc_state%frazil)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + G%areaT(i,j) * sfc_state%frazil(i,j) + heat_in(i,j) = heat_in(i,j) + G%US%L_to_m**2*G%areaT(i,j) * sfc_state%frazil(i,j) enddo ; enddo ; endif if (associated(fluxes%heat_added)) then ; do j=js,je ; do i=is,ie - heat_in(i,j) = heat_in(i,j) + dt*G%areaT(i,j)*fluxes%heat_added(i,j) + heat_in(i,j) = heat_in(i,j) + dt*G%US%L_to_m**2*G%areaT(i,j)*fluxes%heat_added(i,j) enddo ; enddo ; endif ! if (associated(sfc_state%sw_lost)) then ; do j=js,je ; do i=is,ie -! heat_in(i,j) = heat_in(i,j) - G%areaT(i,j) * sfc_state%sw_lost(i,j) +! heat_in(i,j) = heat_in(i,j) - G%US%L_to_m**2*G%areaT(i,j) * sfc_state%sw_lost(i,j) ! enddo ; enddo ; endif if (associated(fluxes%salt_flux)) then ; do j=js,je ; do i=is,ie ! convert salt_flux from kg (salt)/(m^2 s) to ppt * [m s-1]. - salt_in(i,j) = dt*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) + salt_in(i,j) = dt*G%US%L_to_m**2*G%areaT(i,j)*(1000.0*fluxes%salt_flux(i,j)) enddo ; enddo ; endif endif @@ -1128,7 +1131,7 @@ subroutine create_depth_list(G, CS) list_pos = (j_global-1)*G%Domain%niglobal + i_global Dlist(list_pos) = G%bathyT(i,j) - Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) + Arealist(list_pos) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ! These sums reproduce across PEs because the arrays are only nonzero on one PE. @@ -1488,7 +1491,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Area checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') mpp_chksum(field(:,:)) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 0c4b0386a4..f8fc9b7cf9 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -132,8 +132,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, & endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth / GV%Rho0 - Z_to_Pa = GV%g_Earth * GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth / GV%Rho0 + Z_to_Pa = GV%Z_to_H * GV%H_to_Pa use_EOS = associated(tv%eqn_of_state) rescale = 1024.0**4 ; I_rescale = 1.0/rescale @@ -522,7 +522,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes - real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [m s-1] + real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] type(wave_speed_CS), optional, pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: full_halos !< If true, do the calculation !! over the entire computational domain. @@ -577,7 +577,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) integer :: kf(SZI_(G)) integer, parameter :: max_itt = 10 logical :: use_EOS ! If true, density is calculated from T & S using the equation of state. - real, dimension(SZK_(G)+1) :: z_int, N2 + real, dimension(SZK_(G)+1) :: z_int + ! real, dimension(SZK_(G)+1) :: N2 integer :: nsub ! number of subintervals used for root finding integer, parameter :: sub_it_max = 4 ! maximum number of times to subdivide interval @@ -599,9 +600,9 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) endif ; endif S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth / GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) - Z_to_Pa = GV%g_Earth * GV%Rho0 + Z_to_Pa = GV%Z_to_H * GV%H_to_Pa min_h_frac = tol1 / real(nz) !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,T,S, & @@ -778,12 +779,12 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) do K=2,kc Igl(K) = 1.0/(gprime(K)*Hc(k)) ; Igu(K) = 1.0/(gprime(K)*Hc(k-1)) z_int(K) = z_int(K-1) + Hc(k-1) - N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) + ! N2(K) = US%m_to_Z**2*gprime(K)/(0.5*(Hc(k)+Hc(k-1))) speed2_tot = speed2_tot + gprime(K)*(Hc(k-1)+Hc(k)) enddo ! Set stratification for surface and bottom (setting equal to nearest interface for now) - N2(1) = N2(2) ; N2(kc+1) = N2(kc) - ! Calcualte depth at bottom + ! N2(1) = N2(2) ; N2(kc+1) = N2(kc) + ! Calculate depth at bottom z_int(kc+1) = z_int(kc)+Hc(kc) ! check that thicknesses sum to total depth if (abs(z_int(kc+1)-htot(i)) > 1.e-12*htot(i)) then @@ -940,6 +941,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) else cn(i,j,2:nmodes) = 0.0 ! else too small to worry about endif ! if nmodes>1 .and. kc>nmodes .and. c1>c1_thresh + do m=1,nmodes ; cn(i,j,m) = US%m_s_to_L_T*cn(i,j,m) ; enddo else cn(i,j,:) = 0.0 endif ! if more than 2 layers diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index c289c540f0..ac28a8d012 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -96,9 +96,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode internal - !! gravity wave speed [m s-1]. + !! gravity wave speed [L T-1 ~> m s-1]. integer, intent(in) :: ModeNum !< Mode number - real, intent(in) :: freq !< Intrinsic wave frequency [s-1]. + real, intent(in) :: freq !< Intrinsic wave frequency [T-1 ~> s-1]. type(wave_structure_CS), pointer :: CS !< The control structure returned by a !! previous call to wave_structure_init. real, dimension(SZI_(G),SZJ_(G)), & @@ -130,14 +130,14 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real :: I_Hnew, drxh_sum real, parameter :: tol1 = 0.0001, tol2 = 0.001 real, pointer, dimension(:,:,:) :: T => NULL(), S => NULL() - real :: g_Rho0 ! G_Earth/Rho0 in m5 Z-1 s-2 kg-1. - real :: rescale, I_rescale + real :: g_Rho0 ! G_Earth/Rho0 in [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1]. + ! real :: rescale, I_rescale integer :: kf(SZI_(G)) integer, parameter :: max_itt = 1 ! number of times to iterate in solving for eigenvector - real, parameter :: cg_subRO = 1e-100 ! a very small number + real :: cg_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real, parameter :: a_int = 0.5 ! value of normalized integral: \int(w_strct^2)dz = a_int real :: I_a_int ! inverse of a_int - real :: f2 ! squared Coriolis frequency + real :: f2 ! squared Coriolis frequency [T-2 ~> s-2] real :: Kmag2 ! magnitude of horizontal wave number squared logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. @@ -178,11 +178,12 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo Pi = (4.0*atan(1.0)) S => tv%S ; T => tv%T - g_Rho0 = GV%g_Earth /GV%Rho0 + g_Rho0 = US%L_T_to_m_s**2 * GV%g_Earth /GV%Rho0 + cg_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. use_EOS = associated(tv%eqn_of_state) - H_to_pres = GV%g_Earth * GV%Rho0 - rescale = 1024.0**4 ; I_rescale = 1.0/rescale + H_to_pres = GV%Z_to_H*GV%H_to_Pa + ! rescale = 1024.0**4 ; I_rescale = 1.0/rescale min_h_frac = tol1 / real(nz) @@ -248,7 +249,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo !----------------------------------- if (G%mask2dT(i,j) > 0.5) then - lam = 1/(cn(i,j)**2) + lam = 1/(US%L_T_to_m_s**2 * cn(i,j)**2) ! Calculate drxh_sum if (use_EOS) then @@ -421,7 +422,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo do itt=1,max_itt call tridiag_solver(a_diag(1:kc-1),b_diag(1:kc-1),c_diag(1:kc-1), & -lam_z(1:kc-1),e_guess(1:kc-1),"TDMA_H",e_itt) - e_guess(1:kc-1) = e_itt(1:kc-1)/sqrt(sum(e_itt(1:kc-1)**2)) + e_guess(1:kc-1) = e_itt(1:kc-1) / sqrt(sum(e_itt(1:kc-1)**2)) enddo ! itt-loop w_strct(2:kc) = e_guess(1:kc-1) w_strct(1) = 0.0 ! rigid lid at surface @@ -448,26 +449,26 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo enddo !### Some mathematical cancellations could occur in the next two lines. w2avg = w2avg / htot(i,j) - w_strct = w_strct / sqrt(htot(i,j)*w2avg*I_a_int) + w_strct(:) = w_strct(:) / sqrt(htot(i,j)*w2avg*I_a_int) ! Calculate vertical structure function of u (i.e. dw/dz) do K=2,nzm-1 u_strct(K) = 0.5*((w_strct(K-1) - w_strct(K) )/dz(k-1) + & - (w_strct(K) - w_strct(K+1))/dz(k)) + (w_strct(K) - w_strct(K+1))/dz(k)) enddo u_strct(1) = (w_strct(1) - w_strct(2) )/dz(1) - u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) + u_strct(nzm) = (w_strct(nzm-1)- w_strct(nzm))/dz(nzm-1) ! Calculate wavenumber magnitude - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 !f2 = 0.25*US%s_to_T**2 *((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & ! (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) - Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) + Kmag2 = US%m_to_L**2 * (freq**2 - f2) / (cn(i,j)**2 + cg_subRO**2) ! Calculate terms in vertically integrated energy equation int_dwdz2 = 0.0 ; int_w2 = 0.0 ; int_N2w2 = 0.0 - u_strct2 = u_strct(1:nzm)**2 - w_strct2 = w_strct(1:nzm)**2 + u_strct2(:) = u_strct(1:nzm)**2 + w_strct2(:) = w_strct(1:nzm)**2 ! vertical integration with Trapezoidal rule do k=1,nzm-1 int_dwdz2 = int_dwdz2 + 0.5*(u_strct2(K)+u_strct2(K+1))*dz(k) @@ -477,8 +478,9 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (Kmag2 > 0.0) then - KE_term = 0.25*GV%Rho0*( (1+f2/freq**2)/Kmag2*int_dwdz2 + int_w2 ) - PE_term = 0.25*GV%Rho0*( int_N2w2/freq**2 ) + !### This should be simpified to use a single division. + KE_term = 0.25*GV%Rho0*( ((1.0 + f2/freq**2) / Kmag2)*int_dwdz2 + int_w2 ) + PE_term = 0.25*GV%Rho0*( int_N2w2/(US%s_to_T*freq)**2 ) if (En(i,j) >= 0.0) then W0 = sqrt( En(i,j)/(KE_term + PE_term) ) else @@ -487,14 +489,15 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo W0 = 0.0 endif ! Calculate actual vertical velocity profile and derivative - W_profile = W0*w_strct - dWdz_profile = W0*u_strct + W_profile(:) = W0*w_strct(:) + dWdz_profile(:) = W0*u_strct(:) ! Calculate average magnitude of actual horizontal velocity over a period - Uavg_profile = abs(dWdz_profile) * sqrt((1+f2/freq**2)/(2.0*Kmag2)) + !### This should be simpified to use a single division. + Uavg_profile(:) = abs(dWdz_profile(:)) * sqrt((1.0 + f2/freq**2) / (2.0*Kmag2)) else - W_profile = 0.0 - dWdz_profile = 0.0 - Uavg_profile = 0.0 + W_profile(:) = 0.0 + dWdz_profile(:) = 0.0 + Uavg_profile(:) = 0.0 endif ! Store values in control structure diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 9320f503b5..54f1934abd 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3868,7 +3868,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 !This seems to be faster!!!! - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -3896,7 +3896,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo; enddo @@ -3910,7 +3910,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj,k)*diag_cs%G%dyCu(ii,jj)*diag_cs%h(ii,jj,k) + weight =mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj) * diag_cs%h(ii,jj,k) total_weight = total_weight +weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -3966,7 +3966,7 @@ subroutine downsample_field_3d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight = mask(ii,jj,k)*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) + weight = mask(ii,jj,k)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)*diag_cs%h(ii,jj,k) total_weight = total_weight + weight ave=ave+field_in(ii,jj,k)*weight enddo @@ -4037,7 +4037,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 do jj=j0,j0+dl-1 ; do ii=i0,i0+dl-1 ! do ii=i0,i0+dl-1 ; do jj=j0,j0+dl-1 - weight = mask(ii,jj)*diag_cs%G%areaT(ii,jj) + weight = mask(ii,jj)*diag_cs%G%US%L_to_m**2*diag_cs%G%areaT(ii,jj) total_weight = total_weight + weight ave=ave+field_in(ii,jj)*weight enddo; enddo @@ -4093,7 +4093,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 ii=i0 do jj=j0,j0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dyCu(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo @@ -4107,7 +4107,7 @@ subroutine downsample_field_2d(field_in, field_out, dl, method, mask, diag_cs, d total_weight = 0.0 jj=j0 do ii=i0,i0+dl-1 - weight =mask(ii,jj)*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? + weight = mask(ii,jj)*diag_cs%G%US%L_to_m*diag_cs%G%dxCv(ii,jj)!*diag_cs%h(ii,jj,1) !Niki? total_weight = total_weight +weight ave=ave+field_in(ii,jj)*weight enddo diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 6640a4b15a..8f1d309b06 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -673,14 +673,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = i - G%isdB + 1 height = 0.5 * (h(i,j,k) + h(i+1,j,k)) - volume(I,j,k) = G%areaCu(I,j) * height * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * height * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo endif @@ -689,7 +689,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do j=G%jsc, G%jec ; do I=G%isc, G%iec I1 = I - G%isdB + 1 - volume(I,j,k) = G%areaCu(I,j) * G%mask2dCu(I,j) + volume(I,j,k) = G%US%L_to_m**2*G%areaCu(I,j) * G%mask2dCu(I,j) stuff(I,j,k) = volume(I,j,k) * field(I1,j,k) enddo ; enddo enddo @@ -701,14 +701,14 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo else ! Intensive do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 height = 0.5 * (h(i,j,k) + h(i,j+1,k)) - volume(i,J,k) = G%areaCv(i,J) * height * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * height * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo endif @@ -717,7 +717,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, do k=1,nz do J=G%jsc, G%jec ; do i=G%isc, G%iec J1 = J - G%jsdB + 1 - volume(i,J,k) = G%areaCv(i,J) * G%mask2dCv(i,J) + volume(i,J,k) = G%US%L_to_m**2*G%areaCv(i,J) * G%mask2dCv(i,J) stuff(i,J,k) = volume(i,J,k) * field(i,J1,k) enddo ; enddo enddo @@ -729,7 +729,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, if (is_extensive) then do j=G%jsc, G%jec ; do i=G%isc, G%iec if (h(i,j,k) > 0.) then - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) else volume(i,j,k) = 0. @@ -738,7 +738,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, enddo ; enddo else ! Intensive do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo endif @@ -746,7 +746,7 @@ subroutine horizontally_average_diag_field(G, h, staggered_in_x, staggered_in_y, else ! Interface do k=1,nz do j=G%jsc, G%jec ; do i=G%isc, G%iec - volume(i,j,k) = G%areaT(i,j) * G%mask2dT(i,j) + volume(i,j,k) = G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j) stuff(i,j,k) = volume(i,j,k) * field(i,j,k) enddo ; enddo enddo diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 0a83ef983e..ef74a12c9d 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -7,6 +7,7 @@ module MOM_dyn_horgrid use MOM_hor_index, only : hor_index_type use MOM_domains, only : MOM_domain_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -70,12 +71,12 @@ module MOM_dyn_horgrid mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. geoLatT, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonT, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxT, & !< dxT is delta x at h points [m]. - IdxT, & !< 1/dxT [m-1]. - dyT, & !< dyT is delta y at h points [m]. - IdyT, & !< IdyT is 1/dyT [m-1]. - areaT, & !< The area of an h-cell [m2]. - IareaT !< 1/areaT [m-2]. + dxT, & !< dxT is delta x at h points [L ~> m]. + IdxT, & !< 1/dxT [L-1 ~> m-1]. + dyT, & !< dyT is delta y at h points [L ~> m]. + IdyT, & !< IdyT is 1/dyT [L-1 ~> m-1]. + areaT, & !< The area of an h-cell [L2 ~> m2]. + IareaT !< 1/areaT [L-2 ~> m-2]. real, allocatable, dimension(:,:) :: sin_rot !< The sine of the angular rotation between the local model grid's northward !! and the true northward directions [nondim]. @@ -87,36 +88,36 @@ module MOM_dyn_horgrid mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. - dxCu, & !< dxCu is delta x at u points [m]. - IdxCu, & !< 1/dxCu [m-1]. - dyCu, & !< dyCu is delta y at u points [m]. - IdyCu, & !< 1/dyCu [m-1]. - dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [m]. - IareaCu, & !< The masked inverse areas of u-grid cells [m2]. - areaCu !< The areas of the u-grid cells [m2]. + dxCu, & !< dxCu is delta x at u points [L ~> m]. + IdxCu, & !< 1/dxCu [L-1 ~> m-1]. + dyCu, & !< dyCu is delta y at u points [L ~> m]. + IdyCu, & !< 1/dyCu [L-1 ~> m-1]. + dy_Cu, & !< The unblocked lengths of the u-faces of the h-cell [L ~> m]. + IareaCu, & !< The masked inverse areas of u-grid cells [L-2 ~> m-2]. + areaCu !< The areas of the u-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. - dxCv, & !< dxCv is delta x at v points [m]. - IdxCv, & !< 1/dxCv [m-1]. - dyCv, & !< dyCv is delta y at v points [m]. - IdyCv, & !< 1/dyCv [m-1]. - dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [m]. - IareaCv, & !< The masked inverse areas of v-grid cells [m2]. - areaCv !< The areas of the v-grid cells [m2]. + dxCv, & !< dxCv is delta x at v points [L ~> m]. + IdxCv, & !< 1/dxCv [L-1 ~> m-1]. + dyCv, & !< dyCv is delta y at v points [L ~> m]. + IdyCv, & !< 1/dyCv [L-1 ~> m-1]. + dx_Cv, & !< The unblocked lengths of the v-faces of the h-cell [L ~> m]. + IareaCv, & !< The masked inverse areas of v-grid cells [L-2 ~> m-2]. + areaCv !< The areas of the v-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. geoLatBu, & !< The geographic latitude at q points [degrees of latitude] or [m]. geoLonBu, & !< The geographic longitude at q points [degrees of longitude] or [m]. - dxBu, & !< dxBu is delta x at q points [m]. - IdxBu, & !< 1/dxBu [m-1]. - dyBu, & !< dyBu is delta y at q points [m]. - IdyBu, & !< 1/dyBu [m-1]. - areaBu, & !< areaBu is the area of a q-cell [m2] - IareaBu !< IareaBu = 1/areaBu [m-2]. + dxBu, & !< dxBu is delta x at q points [L ~> m]. + IdxBu, & !< 1/dxBu [L-1 ~> m-1]. + dyBu, & !< dyBu is delta y at q points [L ~> m]. + IdyBu, & !< 1/dyBu [L-1 ~> m-1]. + areaBu, & !< areaBu is the area of a q-cell [L ~> m] + 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. @@ -150,10 +151,10 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & CoriolisBu !< The Coriolis parameter at corner points [T-1 ~> s-1]. real, allocatable, dimension(:,:) :: & - df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. - df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 m-1 ~> s-1 m-1]. + df_dx, & !< Derivative d/dx f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. + df_dy !< Derivative d/dy f (Coriolis parameter) at h-points [T-1 L-1 ~> s-1 m-1]. - ! These variables are global sums that are useful for 1-d diagnostics + ! These variables are global sums that are useful for 1-d diagnostics and should not be rescaled. real :: areaT_global !< Global sum of h-cell area [m2] real :: IareaT_global !< Global sum of inverse h-cell area (1/areaT_global) [m-2] @@ -312,12 +313,17 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) end subroutine rescale_dyn_horgrid_bathymetry !> set_derived_dyn_horgrid calculates metric terms that are derived from other metrics. -subroutine set_derived_dyn_horgrid(G) +subroutine set_derived_dyn_horgrid(G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Various inverse grid spacings and derived areas are calculated within this ! subroutine. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [L m-1 ~> nondim] integer :: i, j, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 1d1e153ab9..4746a36f9e 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1370,7 +1370,7 @@ end subroutine log_param_real !> Log the name and values of an array of real model parameter in documentation files. subroutine log_param_real_array(CS, modulename, varname, value, desc, & - units, default) + units, default, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1380,6 +1380,8 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is + !! logged in the debugging parameter file character(len=1320) :: mesg character(len=240) :: myunits @@ -1396,7 +1398,8 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default) + call doc_param(CS%doc, varname, desc, myunits, value, default, & + debuggingParam=debuggingParam) end subroutine log_param_real_array @@ -1739,7 +1742,8 @@ end subroutine get_param_real !> This subroutine reads the values of an array of real model parameters from a parameter file !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value, scale, unscaled) + default, fail_if_missing, do_not_read, do_not_log, debuggingParam, & + static_value, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1759,6 +1763,8 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! value for this parameter, although it might be logged. logical, optional, intent(in) :: do_not_log !< If present and true, do not log this !! parameter to the documentation files + logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is + !! logged in the debugging parameter file real, optional, intent(in) :: scale !< A scaling factor that the parameter is !! multiplied by before it is returned. real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be @@ -1777,7 +1783,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & if (do_log) then call log_param_real_array(CS, modulename, varname, value, desc, & - units, default) + units, default, debuggingParam) endif if (present(unscaled)) unscaled(:) = value(:) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 21d581978a..0cb670197d 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -303,6 +303,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, dimension(:), allocatable :: lat_inp, last_row real :: max_lat, min_lat, pole, max_depth, npole real :: roundoff ! The magnitude of roundoff, usually ~2e-16. + real :: add_offset, scale_factor logical :: add_np character(len=8) :: laynum type(horiz_interp_type) :: Interp @@ -376,6 +377,13 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (rcode /= 0) call MOM_error(FATAL,"error finding missing value for "//& trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_GET_ATT(ncid, varid, "add_offset", add_offset) + if (rcode /= 0) add_offset = 0.0 + + rcode = NF90_GET_ATT(ncid, varid, "scale_factor", scale_factor) + if (rcode /= 0) scale_factor = 1.0 + + if (allocated(lon_in)) deallocate(lon_in) if (allocated(lat_in)) deallocate(lat_in) if (allocated(z_in)) deallocate(z_in) @@ -499,7 +507,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, do i=1,id if (abs(tr_inp(i,j)-missing_value) > abs(roundoff*missing_value)) then mask_in(i,j) = 1.0 - tr_inp(i,j) = tr_inp(i,j) * conversion + tr_inp(i,j) = (tr_inp(i,j)*scale_factor+add_offset) * conversion else tr_inp(i,j) = missing_value endif @@ -512,7 +520,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (k == 1) then call horiz_interp_new(Interp,x_in,y_in,lon_out(is:ie,js:je),lat_out(is:ie,js:je), & - interp_method='bilinear',src_modulo=reentrant_x) + interp_method='bilinear',src_modulo=.true.) endif if (debug) then @@ -788,7 +796,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t ! call fms routine horiz_interp to interpolate input level data to model horizontal grid if (k == 1) then call horiz_interp_new(Interp, x_in, y_in, lon_out(is:ie,js:je), lat_out(is:ie,js:je), & - interp_method='bilinear', src_modulo=reentrant_x) + interp_method='bilinear', src_modulo=.true.) endif if (debug) then diff --git a/src/framework/MOM_spatial_means.F90 b/src/framework/MOM_spatial_means.F90 index 00f1474879..f7084ee7ea 100644 --- a/src/framework/MOM_spatial_means.F90 +++ b/src/framework/MOM_spatial_means.F90 @@ -36,7 +36,7 @@ function global_area_mean(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_mean = reproducing_sum( tmpForSumming ) * G%IareaT_global @@ -54,7 +54,7 @@ function global_area_integral(var,G) tmpForSumming(:,:) = 0. do j=js,je ; do i=is, ie - tmpForSumming(i,j) = ( var(i,j) * (G%areaT(i,j) * G%mask2dT(i,j)) ) + tmpForSumming(i,j) = ( var(i,j) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) ) enddo ; enddo global_area_integral = reproducing_sum( tmpForSumming ) @@ -77,7 +77,7 @@ function global_layer_mean(var, h, G, GV) tmpForSumming(:,:,:) = 0. ; weight(:,:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight(i,j,k) = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j,k) = var(i,j,k) * weight(i,j,k) enddo ; enddo ; enddo @@ -108,7 +108,7 @@ function global_volume_mean(var, h, G, GV) tmpForSumming(:,:) = 0. ; sum_weight(:,:) = 0. do k=1,nz ; do j=js,je ; do i=is,ie - weight_here = (GV%H_to_m * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j)) + weight_here = (GV%H_to_m * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j)) tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * weight_here sum_weight(i,j) = sum_weight(i,j) + weight_here enddo ; enddo ; enddo @@ -141,12 +141,12 @@ function global_mass_integral(h, G, GV, var, on_PE_only) if (present(var)) then do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + var(i,j,k) * & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo else do k=1,nz ; do j=js,je ; do i=is,ie tmpForSumming(i,j) = tmpForSumming(i,j) + & - ((GV%H_to_kg_m2 * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + ((GV%H_to_kg_m2 * h(i,j,k)) * (G%US%L_to_m**2*G%areaT(i,j) * G%mask2dT(i,j))) enddo ; enddo ; enddo endif global_sum = .true. ; if (present(on_PE_only)) global_sum = .not.on_PE_only @@ -325,9 +325,9 @@ subroutine adjust_area_mean_to_zero(array, G, scaling) do j=G%jsc,G%jec ; do i=G%isc,G%iec posVals(i,j) = max(0., array(i,j)) - areaXposVals(i,j) = G%areaT(i,j) * posVals(i,j) + areaXposVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * posVals(i,j) negVals(i,j) = min(0., array(i,j)) - areaXnegVals(i,j) = G%areaT(i,j) * negVals(i,j) + areaXnegVals(i,j) = G%US%L_to_m**2*G%areaT(i,j) * negVals(i,j) enddo ; enddo areaIntPosVals = reproducing_sum( areaXposVals ) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e8f1fecf60..d07fe42676 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -88,7 +88,7 @@ module MOM_ice_shelf real, pointer, dimension(:,:) :: & utide => NULL() !< tidal velocity [m s-1] - real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. + real :: ustar_bg !< A minimum value for ustar under ice shelves [Z T-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves [nondim]. real :: g_Earth !< The gravitational acceleration [m s-2] real :: Cp !< The heat capacity of sea water [J kg-1 degC-1]. @@ -363,10 +363,10 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) v_at_h = state%v(i,j) !### I think that CS%utide**1 should be CS%utide**2 - fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z * & - sqrt(CS%cdrag*((u_at_h**2.0 + v_at_h**2.0) + CS%utide(i,j)**1))) + fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s * & + sqrt(CS%cdrag*((u_at_h**2 + v_at_h**2) + CS%utide(i,j)**1))) - ustar_h = US%Z_to_m*fluxes%ustar_shelf(i,j) + ustar_h = US%Z_to_m*US%s_to_T*fluxes%ustar_shelf(i,j) if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then state%taux_shelf(i,j) = ustar_h*ustar_h*CS%Rho0*Isqrt2 @@ -652,7 +652,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) if (CS%debug) call MOM_forcing_chksum("Before add shelf flux", fluxes, G, CS%US, haloshift=0) - call add_shelf_flux(G, CS, state, fluxes) + call add_shelf_flux(G, US, CS, state, fluxes) ! now the thermodynamic data is passed on... time to update the ice dynamic quantities @@ -686,7 +686,7 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) call disable_averaging(CS%diag) if (present(forces)) then - call add_shelf_forces(G, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & + call add_shelf_forces(G, US, CS, forces, do_shelf_area=(CS%active_shelf_dynamics .or. & CS%override_shelf_movement)) endif @@ -750,8 +750,9 @@ end subroutine change_thickness_using_melt !> This subroutine adds the mechanical forcing fields and perhaps shelf areas, based on !! the ice state in ice_shelf_CS. -subroutine add_shelf_forces(G, CS, forces, do_shelf_area) +subroutine add_shelf_forces(G, US, CS, forces, do_shelf_area) 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(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces logical, optional, intent(in) :: do_shelf_area !< If true find the shelf-covered areas. @@ -780,20 +781,20 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) forces%frac_shelf_u(I,j) = 0.0 if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%areaCu(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i+1,j)) / & - (G%areaT(i,j) + G%areaT(i+1,j))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i+1,j))) enddo ; enddo do J=jsd,jed-1 ; do i=isd,ied forces%frac_shelf_v(i,J) = 0.0 if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%areaCv(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = ((ISS%area_shelf_h(i,j) + ISS%area_shelf_h(i,j+1)) / & - (G%areaT(i,j) + G%areaT(i,j+1))) + (US%L_to_m**2*G%areaT(i,j) + US%L_to_m**2*G%areaT(i,j+1))) enddo ; enddo call pass_vector(forces%frac_shelf_u, forces%frac_shelf_v, G%domain, TO_ALL, CGRID_NE) endif !### Consider working over a smaller array range. do j=jsd,jed ; do i=isd,ied - press_ice = (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) + press_ice = (ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * ISS%mass_shelf(i,j)) if (associated(forces%p_surf)) then if (.not.forces%accumulate_p_surf) forces%p_surf(i,j) = 0.0 forces%p_surf(i,j) = forces%p_surf(i,j) + press_ice @@ -830,8 +831,9 @@ subroutine add_shelf_forces(G, CS, forces, do_shelf_area) end subroutine add_shelf_forces !> This subroutine adds the ice shelf pressure to the fluxes type. -subroutine add_shelf_pressure(G, CS, fluxes) +subroutine add_shelf_pressure(G, US, CS, fluxes) 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), intent(in) :: CS !< This module's control structure. type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be updated. @@ -844,7 +846,7 @@ subroutine add_shelf_pressure(G, CS, fluxes) call MOM_error(FATAL,"add_shelf_pressure: Incompatible ocean and ice shelf grids.") do j=js,je ; do i=is,ie - press_ice = (CS%ISS%area_shelf_h(i,j) * G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) + press_ice = (CS%ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j)) * (CS%g_Earth * CS%ISS%mass_shelf(i,j)) if (associated(fluxes%p_surf)) then if (.not.fluxes%accumulate_p_surf) fluxes%p_surf(i,j) = 0.0 fluxes%p_surf(i,j) = fluxes%p_surf(i,j) + press_ice @@ -858,8 +860,9 @@ subroutine add_shelf_pressure(G, CS, fluxes) end subroutine add_shelf_pressure !> Updates surface fluxes that are influenced by sub-ice-shelf melting -subroutine add_shelf_flux(G, CS, state, fluxes) +subroutine add_shelf_flux(G, US, CS, state, fluxes) 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) :: state!< Surface ocean state type(forcing), intent(inout) :: fluxes !< A structure of surface fluxes that may be used/updated. @@ -903,7 +906,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ISS => CS%ISS - call add_shelf_pressure(G, CS, fluxes) + call add_shelf_pressure(G, US, CS, fluxes) ! Determine ustar and the square magnitude of the velocity in the ! bottom boundary layer. Together these give the TKE source and @@ -936,13 +939,13 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! tauy2 = (asv1 * state%tauy_shelf(i,J-1)**2 + & ! asv2 * state%tauy_shelf(i,J)**2 ) / (asv1 + asv2) - !fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*sqrt(Irho0 * sqrt(taux2 + tauy2))) + ! fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s*sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * G%IareaT(i,j) + fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) * US%m_to_L**2*G%IareaT(i,j) enddo ; enddo endif @@ -993,7 +996,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) !### These hard-coded limits need to be corrected. They are inappropriate here. if (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then - sponge_area = sponge_area + G%areaT(i,j) + sponge_area = sponge_area + US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo @@ -1121,12 +1124,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call MOM_domains_init(CS%grid%domain, param_file, min_halo=wd_halos, symmetric=GRID_SYM_) ! call diag_mediator_init(CS%grid,param_file,CS%diag) ! this needs to be fixed - will probably break when not using coupled driver 0 - call MOM_grid_init(CS%grid, param_file) + call MOM_grid_init(CS%grid, param_file, CS%US) call create_dyn_horgrid(dG, CS%grid%HI) call clone_MOM_domain(CS%grid%Domain, dG%Domain) - call set_grid_metrics(dG, param_file) + call set_grid_metrics(dG, param_file, CS%US) ! call set_diag_mediator_grid(CS%grid, CS%diag) ! The ocean grid possibly uses different symmetry. @@ -1351,7 +1354,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", & - units="m s-1", default=0.0, scale=US%m_to_Z) + units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the surface stress.", units="nondim", & @@ -1362,7 +1365,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "DRAG_BG_VEL is either the assumed bottom velocity (with "//& "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& - "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z) + "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) if (CS%cdrag*drag_bg_vel > 0.0) CS%ustar_bg = sqrt(CS%cdrag)*drag_bg_vel endif @@ -1396,7 +1399,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl ! Set up the Coriolis parameter, G%f, usually analytically. call MOM_initialize_rotation(dG%CoriolisBu, dG, param_file, US) ! This copies grid elements, including bathyT and CoriolisBu from dG to CS%grid. - call copy_dyngrid_to_MOM_grid(dG, CS%grid) + call copy_dyngrid_to_MOM_grid(dG, CS%grid, US) call destroy_dyn_horgrid(dG) @@ -1505,13 +1508,13 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call cpu_clock_end(id_clock_pass) do j=jsd,jed ; do i=isd,ied - if (ISS%area_shelf_h(i,j) > G%areaT(i,j)) then + if (ISS%area_shelf_h(i,j) > US%L_to_m**2*G%areaT(i,j)) then call MOM_error(WARNING,"Initialize_ice_shelf: area_shelf_h exceeds G%areaT.") - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) endif enddo ; enddo if (present(fluxes)) then ; do j=jsd,jed ; do i=isd,ied - if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / G%areaT(i,j) + if (G%areaT(i,j) > 0.0) fluxes%frac_shelf_h(i,j) = ISS%area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; endif if (CS%debug) then @@ -1519,9 +1522,9 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl endif if (present(forces)) & - call add_shelf_forces(G, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) + call add_shelf_forces(G, US, CS, forces, do_shelf_area=.not.CS%solo_ice_sheet) - if (present(fluxes)) call add_shelf_pressure(G, CS, fluxes) + if (present(fluxes)) call add_shelf_pressure(G, US, CS, fluxes) if (CS%active_shelf_dynamics .and. .not.CS%isthermo) then ISS%water_flux(:,:) = 0.0 @@ -1575,7 +1578,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & 'Heat conduction into ice shelf', 'W m-2') CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & - 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m) + 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) if (CS%active_shelf_dynamics) then CS%id_h_mask = register_diag_field('ocean_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') @@ -1684,7 +1687,7 @@ subroutine update_shelf_mass(G, CS, ISS, Time) ISS%area_shelf_h(i,j) = 0.0 ISS%hmask(i,j) = 0. if (ISS%mass_shelf(i,j) > 0.0) then - ISS%area_shelf_h(i,j) = G%areaT(i,j) + ISS%area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) ISS%h_shelf(i,j) = ISS%mass_shelf(i,j) / CS%rho_ice ISS%hmask(i,j) = 1. endif diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 415ae3d813..5e53c09923 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -580,14 +580,16 @@ function ice_time_step_CFL(CS, ISS, G) real :: local_u_max, local_v_max integer :: i, j - min_ratio = 1.0e16 ! This is just an arbitrary large value. + min_ratio = 1.0e16 ! This is just an arbitrary large nondiensional value. do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (ISS%hmask(i,j) == 1.0) then local_u_max = max(abs(CS%u_shelf(i,j)), abs(CS%u_shelf(i+1,j+1)), & abs(CS%u_shelf(i+1,j)), abs(CS%u_shelf(i,j+1))) local_v_max = max(abs(CS%v_shelf(i,j)), abs(CS%v_shelf(i+1,j+1)), & abs(CS%v_shelf(i+1,j)), abs(CS%v_shelf(i,j+1))) - ratio = min(G%areaT(i,j) / (local_u_max+1.0e-12), G%areaT(i,j) / (local_v_max+1.0e-12)) + ! Here the hard-coded 1e-12 has units of m s-1. Consider revising. + ratio = G%US%L_to_m**2*min(G%areaT(i,j) / (local_u_max + 1.0e-12), & + G%areaT(i,j) / (local_v_max + 1.0e-12)) min_ratio = min(min_ratio, ratio) endif ; enddo ; enddo ! i- and j- loops @@ -869,9 +871,9 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Y(:,:) = G%geoLatBu(i-1:i,j-1:j)*1000 else X(2,:) = G%geoLonBu(i,j)*1000 - X(1,:) = G%geoLonBu(i,j)*1000-G%dxT(i,j) + X(1,:) = G%geoLonBu(i,j)*1000 - US%L_to_m*G%dxT(i,j) Y(:,2) = G%geoLatBu(i,j)*1000 - Y(:,1) = G%geoLatBu(i,j)*1000-G%dyT(i,j) + Y(:,1) = G%geoLatBu(i,j)*1000 - US%L_to_m*G%dyT(i,j) endif call bilinear_shape_functions(X, Y, Phi_temp, area) @@ -896,7 +898,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_init = 0 ; err_tempu = 0; err_tempv = 0 @@ -955,7 +957,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u, v, iters, time) Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%areaT, & + CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, G%US%L_to_m**2*G%areaT, & G, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1120,7 +1122,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, u, v, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, isc-1, iec+1, jsc-1, jec+1, CS%density_ice/CS%density_ocean_avg) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1191,7 +1193,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, u, v, taudx, taudy, H_node, float_c call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & H_node, CS%ice_visc, float_cond, G%bathyT(:,:), CS%taub_beta_eff, & - G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) + G%US%L_to_m**2*G%areaT, G, is, ie, js, je, CS%density_ice/CS%density_ocean_avg) ! Au, Av valid region moves in by 1 @@ -1483,7 +1485,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -1603,16 +1605,16 @@ subroutine ice_shelf_advect_thickness_x(CS, G, time_step, hmask, h0, h_after_ufl if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i-1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) endif if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -1712,7 +1714,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -1819,16 +1821,16 @@ subroutine ice_shelf_advect_thickness_y(CS, G, time_step, hmask, h_after_uflux, if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%u_shelf(i-1,j) + CS%u_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1) endif if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then @@ -1952,7 +1954,7 @@ subroutine shelf_advance_front(CS, ISS, G, flux_enter) enddo if (n_flux > 0) then - dxdyh = G%areaT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_reference = h_reference / real(n_flux) partial_vol = ISS%h_shelf(i,j) * ISS%area_shelf_h(i,j) + tot_flux @@ -2140,9 +2142,9 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, TAUD_X, TAUD_Y, OD) cnt = 0 sx = 0 sy = 0 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell @@ -2671,9 +2673,9 @@ subroutine matrix_diagonal(CS, G, float_cond, H_node, nu, beta, hmask, dens_rati do j=jsc-1,jec+1 ; do i=isc-1,iec+1 ; if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j) *1000 @@ -2863,10 +2865,9 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo 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 - - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) + dyh = G%US%L_to_m*G%dyT(i,j) + dxdyh = G%US%L_to_m**2*G%areaT(i,j) X(1:2) = G%geoLonBu(i-1:i,j-1)*1000 X(3:4) = G%geoLonBu(i-1:i,j)*1000 @@ -2882,8 +2883,6 @@ subroutine apply_boundary_values(CS, ISS, G, time, Phisub, H_node, nu, beta, flo ! 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 uq = CS%u_bdry_val(i-1,j-1) * xquad(3-iq) * xquad(3-jq) + & @@ -3020,9 +3019,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u, v) do j=jsd+1,jed-1 do i=isd+1,ied-1 - dxh = G%dxT(i,j) - dyh = G%dyT(i,j) - dxdyh = G%areaT(i,j) + dxh = US%L_to_m*G%dxT(i,j) + dyh = US%L_to_m*G%dyT(i,j) + dxdyh = US%L_to_m**2*G%areaT(i,j) if (ISS%hmask(i,j) == 1) then ux = (u(i,j) + u(i,j-1) - u(i-1,j) - u(i-1,j-1)) / (2*dxh) @@ -3679,7 +3678,7 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_uflux(i,j) = h0(i,j) @@ -3799,18 +3798,18 @@ subroutine ice_shelf_advect_temp_x(CS, G, time_step, hmask, h0, h_after_uflux, f if (at_west_bdry .AND. (hmask(i-1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter(i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & + flux_enter(i,j,1) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i-1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i-1,j) == 4.) then - flux_enter(i,j,1) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) + flux_enter(i,j,1) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i-1,j)*CS%t_bdry_val(i-1,j) endif if (at_east_bdry .AND. (hmask(i+1,j) == 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & + flux_enter(i,j,2) = ABS(u_face) * G%US%L_to_m*G%dyT(i,j) * time_step * CS%t_bdry_val(i+1,j)* & CS%thickness_bdry_val(i+1,j) elseif (CS%u_face_mask(i+1,j) == 4.) then - flux_enter(i,j,2) = G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) + flux_enter(i,j,2) = G%US%L_to_m*G%dyT(i,j) * time_step * CS%u_flux_bdry_val(i+1,j) * CS%t_bdry_val(i+1,j) endif ! if ((i == is) .AND. (hmask(i,j) == 0) .AND. (hmask(i-1,j) == 1)) then @@ -3907,7 +3906,7 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft endif if (hmask(i,j) == 1) then - dxh = G%dxT(i,j) ; dyh = G%dyT(i,j) ; dxdyh = G%areaT(i,j) + dxh = G%US%L_to_m*G%dxT(i,j) ; dyh = G%US%L_to_m*G%dyT(i,j) ; dxdyh = G%US%L_to_m**2*G%areaT(i,j) h_after_vflux(i,j) = h_after_uflux(i,j) stencil(:) = h_after_uflux(i,j-2:j+2) ! fine as long has ny_halo >= 2 @@ -4014,18 +4013,18 @@ subroutine ice_shelf_advect_temp_y(CS, G, time_step, hmask, h_after_uflux, h_aft if (at_south_bdry .AND. (hmask(i,j-1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter(i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & + flux_enter(i,j,3) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j-1)* & CS%thickness_bdry_val(i,j-1) elseif (CS%v_face_mask(i,j-1) == 4.) then - flux_enter(i,j,3) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) + flux_enter(i,j,3) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j-1)*CS%t_bdry_val(i,j-1) endif if (at_north_bdry .AND. (hmask(i,j+1) == 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter(i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & + flux_enter(i,j,4) = ABS(v_face) * G%US%L_to_m*G%dxT(i,j) * time_step * CS%t_bdry_val(i,j+1)* & CS%thickness_bdry_val(i,j+1) elseif (CS%v_face_mask(i,j+1) == 4.) then - flux_enter(i,j,4) = G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) + flux_enter(i,j,4) = G%US%L_to_m*G%dxT(i,j) * time_step * CS%v_flux_bdry_val(i,j+1)*CS%t_bdry_val(i,j+1) endif ! if ((j == js) .AND. (hmask(i,j) == 0) .AND. (hmask(i,j-1) == 1)) then diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index bc00ac61a9..2ace1b2137 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -128,11 +128,11 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! update thickness mask - if (area_shelf_h (i,j) >= G%areaT(i,j)) then + if (area_shelf_h (i,j) >= US%L_to_m**2*G%areaT(i,j)) then hmask(i,j) = 1. elseif (area_shelf_h (i,j) == 0.0) then hmask(i,j) = 0. - elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= G%areaT(i,j))) then + elseif ((area_shelf_h(i,j) > 0) .and. (area_shelf_h(i,j) <= US%L_to_m**2*G%areaT(i,j))) then hmask(i,j) = 2. else call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") @@ -206,11 +206,11 @@ subroutine initialize_ice_thickness_channel(h_shelf, area_shelf_h, hmask, G, US, h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index 5505154d23..16b543387d 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -80,18 +80,18 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, & do j=js,je ; do I=is-1,ie if ((G%areaT(i,j) + G%areaT(i+1,j) > 0.0)) & ! .and. (G%dxdy_u(I,j) > 0.0)) & forces%frac_shelf_u(I,j) = forces%frac_shelf_u(I,j) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i+1,j)*G%areaT(i+1,j))) / & - (G%areaT(i,j) + G%areaT(i+1,j)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i+1,j)*G%US%L_to_m**2*G%areaT(i+1,j))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i+1,j)) ) forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie if ((G%areaT(i,j) + G%areaT(i,j+1) > 0.0)) & ! .and. (G%dxdy_v(i,J) > 0.0)) & forces%frac_shelf_v(i,J) = forces%frac_shelf_v(i,J) + & - (((forces%area_berg(i,j)*G%areaT(i,j)) + & - (forces%area_berg(i,j+1)*G%areaT(i,j+1))) / & - (G%areaT(i,j) + G%areaT(i,j+1)) ) + (((forces%area_berg(i,j)*G%US%L_to_m**2*G%areaT(i,j)) + & + (forces%area_berg(i,j+1)*G%US%L_to_m**2*G%areaT(i,j+1))) / & + (G%US%L_to_m**2*G%areaT(i,j) + G%US%L_to_m**2*G%areaT(i,j+1)) ) forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + kv_rho_ice * & min(forces%mass_berg(i,j), forces%mass_berg(i,j+1)) enddo ; enddo diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index ec2787bae3..c0c7c96a59 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -168,11 +168,11 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C h_shelf (i,j) = 0.0 else if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) hmask (i,j) = 2.0 else - area_shelf_h(i,j) = G%areaT(i,j) + area_shelf_h(i,j) = G%US%L_to_m**2*G%areaT(i,j) hmask (i,j) = 1.0 endif diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index d497a7828e..fd77676008 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -106,14 +106,14 @@ subroutine MOM_initialize_coord(GV, US, PF, write_geom, output_dir, tv, max_dept "Unrecognized coordinate setup"//trim(config)) end select if (debug) call chksum(GV%Rlay, "MOM_initialize_coord: Rlay ", 1, nz) - if (debug) call chksum(US%m_to_Z*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) + if (debug) call chksum(US%m_to_Z*US%L_to_m**2*US%s_to_T**2*GV%g_prime(:), "MOM_initialize_coord: g_prime ", 1, nz) call setVerticalGridAxes( GV%Rlay, GV ) ! Copy the maximum depth across from the input argument GV%max_depth = max_depth ! Write out all of the grid data used by this run. - if (write_geom) call write_vertgrid_file(GV, PF, output_dir) + if (write_geom) call write_vertgrid_file(GV, US, PF, output_dir) call callTree_leave('MOM_initialize_coord()') @@ -126,7 +126,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -141,10 +141,10 @@ subroutine set_coord_from_gprime(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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) 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%Z_to_m) + units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo @@ -160,7 +160,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -176,7 +176,7 @@ subroutine set_coord_from_layer_density(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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, 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=GV%Rho0) @@ -203,7 +203,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -228,10 +228,10 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state "The initial salinities.", units="PSU", default=35.0) 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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) 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%Z_to_m) + units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) ! ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs @@ -254,7 +254,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -273,7 +273,7 @@ subroutine set_coord_from_TS_profile(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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and "//& "salinities are read.", fail_if_missing=.true.) @@ -302,7 +302,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -354,7 +354,7 @@ subroutine set_coord_from_TS_range(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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -385,7 +385,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -401,7 +401,7 @@ subroutine set_coord_from_file(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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -436,7 +436,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -456,7 +456,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) units="kg m-3", default=2.0) 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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -480,7 +480,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) real, dimension(:), intent(out) :: Rlay !< The layers' target coordinate values !! (potential density) [kg m-3]. real, dimension(:), intent(out) :: g_prime !< The reduced gravity across the interfaces, - !! [m2 Z-1 s-2 ~> m s-2]. + !! [L2 Z-1 T-2 ~> m s-2]. 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 @@ -494,7 +494,7 @@ 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%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%m_s_to_L_T**2*US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo @@ -507,8 +507,9 @@ end subroutine set_coord_to_none !> Writes out a file containing any available data related !! to the vertical grid used by the MOM ocean model. -subroutine write_vertgrid_file(GV, param_file, directory) +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. ! Local variables @@ -525,7 +526,7 @@ subroutine write_vertgrid_file(GV, param_file, directory) call create_file(unit, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) call write_field(unit, fields(1), GV%Rlay) - call write_field(unit, fields(2), GV%g_prime) !### RESCALE THIS? + call write_field(unit, fields(2), US%L_T_to_m_s**2*US%m_to_Z*GV%g_prime(:)) call close_file(unit) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 71d9c4f90b..8ed9a0a4c7 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -78,7 +78,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) inputdir = slasher(inputdir) ! Set up the parameters of the physical domain (i.e. the grid), G - call set_grid_metrics(G, PF) + call set_grid_metrics(G, PF, US) ! Set up the bottom depth, G%bathyT either analytically or from file ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, @@ -99,7 +99,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call initialize_masks(G, PF, US) ! Make OBC mask consistent with land mask - call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv) + call open_boundary_impose_land_mask(OBC, G, G%areaCu, G%areaCv, US) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1, scale=US%Z_to_m) @@ -124,9 +124,9 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) default="none") select case ( trim(config) ) case ("none") - case ("list") ; call reset_face_lengths_list(G, PF) - case ("file") ; call reset_face_lengths_file(G, PF) - case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config)) + case ("list") ; call reset_face_lengths_list(G, PF, US) + case ("file") ; call reset_face_lengths_file(G, PF, US) + case ("global_1deg") ; call reset_face_lengths_named(G, PF, trim(config), US) case default ; call MOM_error(FATAL, "MOM_initialize_fixed: "// & "Unrecognized channel configuration "//trim(config)) end select @@ -152,8 +152,8 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) call MOM_calculate_grad_Coriolis(G%dF_dx, G%dF_dy, G, US=US) if (debug) then call qchksum(G%CoriolisBu, "MOM_initialize_fixed: f ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%s_to_T) - call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%s_to_T) + call hchksum(G%dF_dx, "MOM_initialize_fixed: dF_dx ", G%HI, scale=US%m_to_L*US%s_to_T) + call hchksum(G%dF_dy, "MOM_initialize_fixed: dF_dy ", G%HI, scale=US%m_to_L*US%s_to_T) endif call initialize_grid_rotation_angle(G, PF) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 305087dc44..1c594f45c1 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -87,10 +87,10 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" select case (trim(config)) - case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file) - case ("cartesian"); call set_grid_metrics_cartesian(G, param_file) - case ("spherical"); call set_grid_metrics_spherical(G, param_file) - case ("mercator"); call set_grid_metrics_mercator(G, param_file) + case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) + case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) + case ("spherical"); call set_grid_metrics_spherical(G, param_file, US) + case ("mercator"); call set_grid_metrics_mercator(G, param_file, US) case ("file"); call MOM_error(FATAL, "MOM_grid_init: set_grid_metrics "//& 'GRID_CONFIG "file" is no longer a supported option. Use a '//& 'mosaic file ("mosaic") or one of the analytic forms instead.') @@ -100,10 +100,10 @@ subroutine set_grid_metrics(G, param_file, US) ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") - call set_derived_dyn_horgrid(G) + call set_derived_dyn_horgrid(G, US) call callTree_leave("set_derived_metrics()") - if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics',G) + if (debug) call grid_metrics_chksum('MOM_grid_init/set_grid_metrics', G, US) call callTree_leave("set_grid_metrics()") end subroutine set_grid_metrics @@ -112,42 +112,40 @@ end subroutine set_grid_metrics !> grid_metrics_chksum performs a set of checksums on metrics on the grid for !! debugging. -subroutine grid_metrics_chksum(parent, G) - character(len=*), intent(in) :: parent !< A string identifying the caller +subroutine grid_metrics_chksum(parent, G, US) + character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] integer :: halo + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m halo = min(G%ied-G%iec, G%jed-G%jec, 1) - call hchksum_pair(trim(parent)//': d[xy]T', & - G%dxT, G%dyT, G%HI, haloshift=halo) + call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', & - G%dyCu, G%dxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', & - G%dxBu, G%dyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) - call hchksum_pair(trim(parent)//': Id[xy]T', & - G%IdxT, G%IdyT, G%HI, haloshift=halo) + call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, haloshift=halo, scale=m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdxCu, G%IdyCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', & - G%IdyCu, G%IdxCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', & - G%IdxBu, G%IdyBu, G%HI, haloshift=halo) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo) + call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) + call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo) + call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) + call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) call hchksum(G%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -155,20 +153,19 @@ subroutine grid_metrics_chksum(parent, G) call Bchksum(G%geoLonBu, trim(parent)//': geoLonBu',G%HI, haloshift=halo) call Bchksum(G%geoLatBu, trim(parent)//': geoLatBu',G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLonC[uv]', & - G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLonC[uv]', G%geoLonCu, G%geoLonCv, G%HI, haloshift=halo) - call uvchksum(trim(parent)//': geoLatC[uv]', & - G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) + call uvchksum(trim(parent)//': geoLatC[uv]', G%geoLatCu, G%geoLatCv, G%HI, haloshift=halo) end subroutine grid_metrics_chksum ! ------------------------------------------------------------------------------ !> Sets the grid metrics from a mosaic file. -subroutine set_grid_metrics_from_mosaic(G, param_file) +subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 @@ -186,6 +183,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) @@ -198,6 +196,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) @@ -355,16 +354,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = dxT(i,j) ; G%dyT(i,j) = dyT(i,j) ; G%areaT(i,j) = areaT(i,j) + G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = dxCu(I,j) ; G%dyCu(I,j) = dyCu(I,j) + G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = dxCv(i,J) ; G%dyCv(i,J) = dyCv(i,J) + G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = dxBu(I,J) ; G%dyBu(I,J) = dyBu(I,J) ; G%areaBu(I,J) = areaBu(I,J) + G%dxBu(I,J) = m_to_L*dxBu(I,J) ; G%dyBu(I,J) = m_to_L*dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -415,17 +414,20 @@ end subroutine set_grid_metrics_from_mosaic !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_cartesian(G, param_file) +subroutine set_grid_metrics_cartesian(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dx_everywhere, dy_everywhere ! Grid spacings in m. - real :: I_dx, I_dy ! Inverse grid spacings in m. + real :: dx_everywhere, dy_everywhere ! Grid spacings [m]. + real :: I_dx, I_dy ! Inverse grid spacings [m-1]. real :: PI + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -436,6 +438,8 @@ subroutine set_grid_metrics_cartesian(G, param_file) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -510,30 +514,30 @@ subroutine set_grid_metrics_cartesian(G, param_file) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = grid_lonB(I) ; G%geoLatBu(I,J) = grid_latB(J) - G%dxBu(I,J) = dx_everywhere ; G%IdxBu(I,J) = I_dx - G%dyBu(I,J) = dy_everywhere ; G%IdyBu(I,J) = I_dy - G%areaBu(I,J) = dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = I_dx * I_dy + G%dxBu(I,J) = m_to_L*dx_everywhere ; G%IdxBu(I,J) = L_to_m*I_dx + G%dyBu(I,J) = m_to_L*dy_everywhere ; G%IdyBu(I,J) = L_to_m*I_dy + G%areaBu(I,J) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaBu(I,J) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = grid_lonT(i) ; G%geoLatT(i,j) = grid_LatT(j) - G%dxT(i,j) = dx_everywhere ; G%IdxT(i,j) = I_dx - G%dyT(i,j) = dy_everywhere ; G%IdyT(i,j) = I_dy - G%areaT(i,j) = dx_everywhere * dy_everywhere ; G%IareaT(i,j) = I_dx * I_dy + G%dxT(i,j) = m_to_L*dx_everywhere ; G%IdxT(i,j) = L_to_m*I_dx + G%dyT(i,j) = m_to_L*dy_everywhere ; G%IdyT(i,j) = L_to_m*I_dy + G%areaT(i,j) = m_to_L**2*dx_everywhere * dy_everywhere ; G%IareaT(i,j) = L_to_m**2*I_dx * I_dy enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = grid_lonB(I) ; G%geoLatCu(I,j) = grid_LatT(j) - G%dxCu(I,j) = dx_everywhere ; G%IdxCu(I,j) = I_dx - G%dyCu(I,j) = dy_everywhere ; G%IdyCu(I,j) = I_dy + G%dxCu(I,j) = m_to_L*dx_everywhere ; G%IdxCu(I,j) = L_to_m*I_dx + G%dyCu(I,j) = m_to_L*dy_everywhere ; G%IdyCu(I,j) = L_to_m*I_dy enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = grid_lonT(i) ; G%geoLatCv(i,J) = grid_latB(J) - G%dxCv(i,J) = dx_everywhere ; G%IdxCv(i,J) = I_dx - G%dyCv(i,J) = dy_everywhere ; G%IdyCv(i,J) = I_dy + G%dxCv(i,J) = m_to_L*dx_everywhere ; G%IdxCv(i,J) = L_to_m*I_dx + G%dyCv(i,J) = m_to_L*dy_everywhere ; G%IdyCv(i,J) = L_to_m*I_dy enddo ; enddo call callTree_leave("set_grid_metrics_cartesian()") @@ -548,9 +552,10 @@ end subroutine set_grid_metrics_cartesian !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_spherical(G, param_file) +subroutine set_grid_metrics_spherical(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -559,6 +564,7 @@ subroutine set_grid_metrics_spherical(G, param_file) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -568,6 +574,7 @@ subroutine set_grid_metrics_spherical(G, param_file) i_offset = G%idg_offset ; j_offset = G%jdg_offset call callTree_enter("set_grid_metrics_spherical(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. @@ -630,9 +637,9 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxBu(I,J) = G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di -! G%dxBu(I,J) = G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) - G%dyBu(I,J) = G%Rad_Earth * dLat*PI_180 + G%dxBu(I,J) = m_to_L*G%Rad_Earth * COS( G%geoLatBu(I,J)*PI_180 ) * dL_di +! G%dxBu(I,J) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( G%geoLatBu(I,J)*PI_180 ) + G%dyBu(I,J) = m_to_L*G%Rad_Earth * dLat*PI_180 G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) enddo ; enddo @@ -642,9 +649,9 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCv(i,J) = G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di -! G%dxCv(i,J) = G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) - G%dyCv(i,J) = G%Rad_Earth * dLat*PI_180 + G%dxCv(i,J) = m_to_L*G%Rad_Earth * COS( G%geoLatCv(i,J)*PI_180 ) * dL_di +! G%dxCv(i,J) = m_to_L*G%Rad_Earth * (dLon*PI_180) * COS( G%geoLatCv(i,J)*PI_180 ) + G%dyCv(i,J) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB @@ -653,9 +660,9 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxCu(I,j) = G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di -! G%dxCu(I,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyCu(I,j) = G%Rad_Earth * dLat*PI_180 + G%dxCu(I,j) = m_to_L*G%Rad_Earth * COS( G%geoLatCu(I,j)*PI_180 ) * dL_di +! G%dxCu(I,j) = m_to_L*G%Rad_Earth * dLon*PI_180 * COS( latitude ) + G%dyCu(I,j) = m_to_L*G%Rad_Earth * dLat*PI_180 enddo ; enddo do j=jsd,jed ; do i=isd,ied @@ -664,13 +671,13 @@ subroutine set_grid_metrics_spherical(G, param_file) ! The following line is needed to reproduce the solution from ! set_grid_metrics_mercator when used to generate a simple spherical grid. - G%dxT(i,j) = G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di + G%dxT(i,j) = m_to_L*G%Rad_Earth * COS( G%geoLatT(i,j)*PI_180 ) * dL_di ! G%dxT(i,j) = G%Rad_Earth * dLon*PI_180 * COS( latitude ) - G%dyT(i,j) = G%Rad_Earth * dLat*PI_180 + G%dyT(i,j) = m_to_L*G%Rad_Earth * dLat*PI_180 ! latitude = G%geoLatCv(i,J)*PI_180 ! In radians ! dL_di = G%geoLatCv(i,max(jsd,J-1))*PI_180 ! In radians -! G%areaT(i,j) = Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) +! G%areaT(i,j) = m_to_L**2 * Rad_Earth**2*dLon*dLat*ABS(SIN(latitude)-SIN(dL_di)) G%areaT(i,j) = G%dxT(i,j) * G%dyT(i,j) enddo ; enddo @@ -684,9 +691,10 @@ end subroutine set_grid_metrics_spherical !! inverses and the cell areas centered on h, q, u, and v points are !! calculated, as are the geographic locations of each of these 4 !! sets of points. -subroutine set_grid_metrics_mercator(G, param_file) +subroutine set_grid_metrics_mercator(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -706,6 +714,7 @@ subroutine set_grid_metrics_mercator(G, param_file) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -724,6 +733,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI @@ -853,40 +863,40 @@ subroutine set_grid_metrics_mercator(G, param_file) do J=JsdB,JedB ; do I=IsdB,IedB G%geoLonBu(I,J) = xq(I,J)*180.0/PI G%geoLatBu(I,J) = yq(I,J)*180.0/PI - G%dxBu(I,J) = ds_di(xq(I,J), yq(I,J), GP) - G%dyBu(I,J) = ds_dj(xq(I,J), yq(I,J), GP) + G%dxBu(I,J) = m_to_L*ds_di(xq(I,J), yq(I,J), GP) + G%dyBu(I,J) = m_to_L*ds_dj(xq(I,J), yq(I,J), GP) G%areaBu(I,J) = G%dxBu(I,J) * G%dyBu(I,J) - G%IareaBu(I,J) = 1.0 / G%areaBu(I,J) + G%IareaBu(I,J) = 1.0 / (G%areaBu(I,J)) enddo ; enddo do j=jsd,jed ; do i=isd,ied G%geoLonT(i,j) = xh(i,j)*180.0/PI G%geoLatT(i,j) = yh(i,j)*180.0/PI - G%dxT(i,j) = ds_di(xh(i,j), yh(i,j), GP) - G%dyT(i,j) = ds_dj(xh(i,j), yh(i,j), GP) + G%dxT(i,j) = m_to_L*ds_di(xh(i,j), yh(i,j), GP) + G%dyT(i,j) = m_to_L*ds_dj(xh(i,j), yh(i,j), GP) G%areaT(i,j) = G%dxT(i,j)*G%dyT(i,j) - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo do j=jsd,jed ; do I=IsdB,IedB G%geoLonCu(I,j) = xu(I,j)*180.0/PI G%geoLatCu(I,j) = yu(I,j)*180.0/PI - G%dxCu(I,j) = ds_di(xu(I,j), yu(I,j), GP) - G%dyCu(I,j) = ds_dj(xu(I,j), yu(I,j), GP) + G%dxCu(I,j) = m_to_L*ds_di(xu(I,j), yu(I,j), GP) + G%dyCu(I,j) = m_to_L*ds_dj(xu(I,j), yu(I,j), GP) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied G%geoLonCv(i,J) = xv(i,J)*180.0/PI G%geoLatCv(i,J) = yv(i,J)*180.0/PI - G%dxCv(i,J) = ds_di(xv(i,J), yv(i,J), GP) - G%dyCv(i,J) = ds_dj(xv(i,J), yv(i,J), GP) + G%dxCv(i,J) = m_to_L*ds_di(xv(i,J), yv(i,J), GP) + G%dyCv(i,J) = m_to_L*ds_dj(xv(i,J), yv(i,J), GP) enddo ; enddo if (.not.simple_area) then do j=JsdB+1,jed ; do i=IsdB+1,ied - G%areaT(I,J) = GP%Rad_Earth**2 * & + G%areaT(I,J) = m_to_L**2*GP%Rad_Earth**2 * & (dL(xq(I-1,J-1),xq(I-1,J),yq(I-1,J-1),yq(I-1,J)) + & (dL(xq(I-1,J),xq(I,J),yq(I-1,J),yq(I,J)) + & (dL(xq(I,J),xq(I,J-1),yq(I,J),yq(I,J-1)) + & @@ -903,7 +913,7 @@ subroutine set_grid_metrics_mercator(G, param_file) call pass_var(G%areaT,G%Domain) endif do j=jsd,jed ; do i=isd,ied - G%IareaT(i,j) = 1.0 / G%areaT(i,j) + G%IareaT(i,j) = 1.0 / (G%areaT(i,j)) enddo ; enddo endif @@ -1227,6 +1237,7 @@ subroutine initialize_masks(G, PF, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: m_to_Z_scale ! A unit conversion factor from m to Z. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: Dmin ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1235,6 +1246,8 @@ subroutine initialize_masks(G, PF, US) call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 42e99f2ef6..3d0fe6f1ed 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -90,14 +90,17 @@ end subroutine MOM_initialize_rotation subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dx !< x-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dx !< x-component of grad f [T-1 L-1 ~> s-1 m-1] real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: dF_dy !< y-component of grad f [T-1 m-1 ~> s-1 m-1] + intent(out) :: dF_dy !< y-component of grad f [T-1 L-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] real :: f1, f2 + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. @@ -114,6 +117,7 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) + end subroutine MOM_calculate_grad_Coriolis !> Return the global maximum ocean bottom depth in the same units as the input depth. @@ -623,6 +627,8 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: dx_2 = -1.0, dy_2 = -1.0 real :: pi_180 integer :: option = -1 @@ -637,68 +643,70 @@ subroutine reset_face_lengths_named(G, param_file, name, US) "Unrecognized channel configuration name "//trim(name)) end select + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m + if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0 ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*m_to_L ! Gibraltar if ((abs(G%geoLatCu(I,j)-12.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-43.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0 ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*m_to_L ! Red Sea if ((abs(G%geoLatCu(I,j)-40.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-26.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0 ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*m_to_L ! Dardanelles if ((abs(G%geoLatCu(I,j)-41.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+220.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0 ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*m_to_L ! Tsugaru strait at 140.0e if ((abs(G%geoLatCu(I,j)-45.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+217.5) < 0.9)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0 ! Betw Hokkaido and Sakhalin at 217&218 = 142e - + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCu(I,j)-80.84) < 0.2) .and. (abs(G%geoLonCu(I,j)+64.9) < 0.8)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0 ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*m_to_L ! Smith Sound in Canadian Arch - tripolar region enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0 ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. if ((abs(G%geoLatCv(i,J)-13.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-42.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0 ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*m_to_L ! Red Sea if ((abs(G%geoLatCv(i,J)+2.8) < 0.8) .and. (abs(G%geoLonCv(i,J)+241.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0 ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*m_to_L ! Makassar Straits at 241.5 W = 118.5 E if ((abs(G%geoLatCv(i,J)-0.56) < 0.5) .and. (abs(G%geoLonCv(i,J)+240.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0 ! entry to Makassar Straits at 240.5 W = 119.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+230.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+229.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E if ((abs(G%geoLatCv(i,J)-0.0) < 0.25) .and. (abs(G%geoLonCv(i,J)+228.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0 ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+244.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0 ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Lombok Straits at 244.5 W = 115.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+235.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0 ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Timor Straits at 235.5 W = 124.5 E if ((abs(G%geoLatCv(i,J)-52.5) < dy_2) .and. (abs(G%geoLonCv(i,J)+218.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0 ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCv(i,J)-76.8) < 0.06) .and. (abs(G%geoLonCv(i,J)+88.7) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0 ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -706,30 +714,30 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo end subroutine reset_face_lengths_named @@ -747,12 +755,16 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] 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 ! These checks apply regardless of the chosen option. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -767,34 +779,34 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (G%dy_Cu(I,j) > G%dyCu(I,j)) then + if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - G%dy_Cu(I,j), G%dyCu(I,j), G%dy_Cu(I,j)-G%dyCu(I,j), & + L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (G%dx_Cv(i,J) > G%dxCv(i,J)) then + if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - G%dx_Cv(i,J), G%dxCv(i,J), G%dx_Cv(i,J)-G%dxCv(i,J), & + L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo call callTree_leave(trim(mdl)//'()') @@ -818,6 +830,8 @@ subroutine reset_face_lengths_list(G, param_file, US) u_lat => NULL(), u_lon => NULL(), v_lat => NULL(), v_lon => NULL() real, pointer, dimension(:) :: & u_width => NULL(), v_width => NULL() + real :: m_to_L ! A unit conversion factor [L m-1 ~> nondim] + real :: L_to_m ! A unit conversion factor [m L-1 ~> nondim] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -833,6 +847,8 @@ subroutine reset_face_lengths_list(G, param_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L + L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -976,7 +992,7 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * m_to_L*min(L_to_m*G%dyCu(I,j), max(u_width(npt), 0.0)) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCu=0 at ",lat,lon," (",& @@ -984,15 +1000,15 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& - u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",G%dy_Cu(I,j),"m" + u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" endif endif endif enddo - G%areaCu(I,j) = G%dxCu(I,j)*G%dy_Cu(I,j) + G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = 0.0 - if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / G%areaCu(I,j) + if (G%areaCu(I,j) > 0.0) G%IareaCu(I,j) = G%mask2dCu(I,j) / (G%areaCu(I,j)) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied @@ -1005,7 +1021,7 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * m_to_L*min(L_to_m*G%dxCv(i,J), max(v_width(npt), 0.0)) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then write(*,'(A,2F8.2,A,4F8.2,A)') "read_face_lengths_list : G%mask2dCv=0 at ",lat,lon," (",& @@ -1013,15 +1029,15 @@ subroutine reset_face_lengths_list(G, param_file, US) else write(*,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& - v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",G%dx_Cv(I,j),"m" + v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" endif endif endif enddo - G%areaCv(i,J) = G%dyCv(i,J)*G%dx_Cv(i,J) + G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = 0.0 - if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) + if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / (G%areaCv(i,J)) enddo ; enddo if (num_lines > 0) then @@ -1147,7 +1163,7 @@ subroutine compute_global_grid_integrals(G) call MOM_error(FATAL, "compute_global_grid_integrals: "//& "zero ocean area (check topography?)") - G%IareaT_global = 1. / G%areaT_global + G%IareaT_global = 1.0 / (G%areaT_global) end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- @@ -1170,6 +1186,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) type(fieldtype) :: fields(nFlds) real :: Z_to_m_scale ! A unit conversion factor from Z to m. real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1. + real :: L_to_m_scale ! A unit conversion factor from L to m. integer :: unit integer :: file_threading integer :: nFlds_used @@ -1188,6 +1205,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T + L_to_m_scale = 1.0 ; if (present(US)) L_to_m_scale = US%L_to_m ! vardesc is a structure defined in MOM_io.F90. The elements of ! this structure, in order, are: @@ -1265,24 +1283,24 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) ! I think that all of these copies are holdovers from a much earlier ! ancestor code in which many of the metrics were macros that could have ! had reduced dimensions, and that they are no longer needed in MOM6. -RWH - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dxCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dxCv(i,J) ; enddo ; enddo call write_field(unit, fields(7), G%Domain%mpp_domain, out_v) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dyCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dyCu(I,j) ; enddo ; enddo call write_field(unit, fields(8), G%Domain%mpp_domain, out_u) - do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = G%dxCu(I,j) ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dxCu(I,j) ; enddo ; enddo call write_field(unit, fields(9), G%Domain%mpp_domain, out_u) - do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = G%dyCv(i,J) ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dyCv(i,J) ; enddo ; enddo call write_field(unit, fields(10), G%Domain%mpp_domain, out_v) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dxT(i,j); enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dxT(i,j); enddo ; enddo call write_field(unit, fields(11), G%Domain%mpp_domain, out_h) - do j=js,je ; do i=is,ie ; out_h(i,j) = G%dyT(i,j) ; enddo ; enddo + do j=js,je ; do i=is,ie ; out_h(i,j) = L_to_m_scale*G%dyT(i,j) ; enddo ; enddo call write_field(unit, fields(12), G%Domain%mpp_domain, out_h) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = G%dxBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(i,J) = L_to_m_scale*G%dxBu(I,J) ; enddo ; enddo call write_field(unit, fields(13), G%Domain%mpp_domain, out_q) - do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%dyBu(I,J) ; enddo ; enddo + do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = L_to_m_scale*G%dyBu(I,J) ; enddo ; enddo call write_field(unit, fields(14), G%Domain%mpp_domain, out_q) do j=js,je ; do i=is,ie ; out_h(i,j) = G%areaT(i,j) ; enddo ; enddo @@ -1290,8 +1308,10 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) do J=Jsq,Jeq ; do I=Isq,Ieq ; out_q(I,J) = G%areaBu(I,J) ; enddo ; enddo call write_field(unit, fields(16), G%Domain%mpp_domain, out_q) - call write_field(unit, fields(17), G%Domain%mpp_domain, G%dx_Cv) - call write_field(unit, fields(18), G%Domain%mpp_domain, G%dy_Cu) + do J=Jsq,Jeq ; do i=is,ie ; out_v(i,J) = L_to_m_scale*G%dx_Cv(i,J) ; enddo ; enddo + call write_field(unit, fields(17), G%Domain%mpp_domain, out_v) + do j=js,je ; do I=Isq,Ieq ; out_u(I,j) = L_to_m_scale*G%dy_Cu(I,j) ; enddo ; enddo + call write_field(unit, fields(18), G%Domain%mpp_domain, out_u) call write_field(unit, fields(19), G%Domain%mpp_domain, G%mask2dT) if (G%bathymetry_at_vel) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index aec93f0942..063c970f94 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -26,6 +26,7 @@ module MOM_state_initialization use MOM_open_boundary, only : set_tracer_data use MOM_open_boundary, only : open_boundary_test_extern_h use MOM_open_boundary, only : fill_temp_salt_segments +use MOM_open_boundary, only : update_OBC_segment_data !use MOM_open_boundary, only : set_3D_OBC_data use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, determine_is_new_run, MOM_restart_CS @@ -126,10 +127,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: u !< The zonal velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: v !< The meridional velocity that is being - !! initialized [m s-1] + !! initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic @@ -153,9 +154,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: dt ! The baroclinic dynamics timestep for this run [s]. + real :: H_rescale ! A rescaling factor for thicknesses from the representation in + ! a restart file to the internal representation in this run. + real :: vel_rescale ! A rescaling factor for velocities from the representation in + ! a restart file to the internal representation in this run. + real :: dt ! The baroclinic dynamics timestep for this run [s]. logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -405,20 +408,20 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, PF, & + case ("file"); call initialize_velocity_from_file(u, v, G, US, PF, & just_read_params=just_read) case ("zero"); call initialize_velocity_zero(u, v, G, PF, & just_read_params=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, PF, & + case ("uniform"); call initialize_velocity_uniform(u, v, G, US, PF, & just_read_params=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, PF, & + case ("circular"); call initialize_velocity_circular(u, v, G, US, PF, & just_read_params=just_read) case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read_params=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G) - case ("USER"); call user_initialize_velocity(u, v, G, PF, & + case ("soliton"); call soliton_initialize_velocity(u, v, h, G, US) + case ("USER"); call user_initialize_velocity(u, v, G, US, PF, & just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) @@ -426,7 +429,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly @@ -493,6 +496,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & H_rescale = GV%m_to_H / GV%m_to_H_restart do k=1,nz ; do j=js,je ; do i=is,ie ; h(i,j,k) = H_rescale * h(i,j,k) ; enddo ; enddo ; enddo endif + if ( (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + ((US%m_to_L * US%s_to_T_restart) /= (US%m_to_L_restart * US%s_to_T)) ) then + vel_rescale = (US%m_to_L * US%s_to_T_restart) / (US%m_to_L_restart * US%s_to_T) + do k=1,nz ; do j=jsd,jed ; do I=IsdB,IeDB ; u(I,j,k) = vel_rescale * u(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; v(i,J,k) = vel_rescale * v(i,J,k) ; enddo ; enddo ; enddo + endif endif if ( use_temperature ) then @@ -557,6 +566,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then + ! Call this once to fill boundary arrays from fixed values + if (.not. OBC%needs_IO_for_data) & + call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) + 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"//& " DOME - specified inflow on northern boundary\n"//& @@ -938,8 +951,8 @@ subroutine convert_thickness(h, G, GV, US, tv) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB max_itt = 10 Boussinesq = GV%Boussinesq - I_gEarth = 1.0 / (GV%g_Earth*US%m_to_Z) - Hm_rho_to_Pa = GV%g_Earth * GV%H_to_Z ! = GV%H_to_Pa / GV%Rho0 + I_gEarth = 1.0 / (GV%mks_g_Earth) + Hm_rho_to_Pa = GV%mks_g_Earth * GV%H_to_m ! = GV%H_to_Pa / GV%Rho0 if (Boussinesq) then call MOM_error(FATAL,"Not yet converting thickness with Boussinesq approx.") @@ -980,7 +993,7 @@ subroutine convert_thickness(h, G, GV, US, tv) enddo else do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = (h(i,j,k) * GV%Rlay(k)) * Hm_rho_to_Pa + h(i,j,k) = (h(i,j,k) * GV%Rlay(k)) * Hm_rho_to_Pa * GV%kg_m2_to_H**2 ! This is mathematically equivalent to ! h(i,j,k) = h(i,j,k) * (GV%Rlay(k) / GV%Rho0) enddo ; enddo ; enddo @@ -1141,7 +1154,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read_params) endif do j=G%jsc,G%jec ; do i=G%isc,G%iec - call cut_off_column_top(GV%ke, tv, GV, GV%g_Earth, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, GV%mks_g_Earth*US%Z_to_m, G%bathyT(i,j), & min_thickness, tv%T(i,j,:), T_t(i,j,:), T_b(i,j,:), & tv%S(i,j,:), S_t(i,j,:), S_b(i,j,:), p_surf(i,j), h(i,j,:), remap_CS, & z_tol=1.0e-5*US%m_to_Z) @@ -1238,12 +1251,13 @@ subroutine cut_off_column_top(nk, tv, GV, G_earth, depth, min_thickness, & end subroutine cut_off_column_top !> Initialize horizontal velocity components from file -subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_from_file(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1272,7 +1286,7 @@ subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) " initialize_velocity_from_file: Unable to open "//trim(filename)) ! Read the velocities from a netcdf file. - call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:),G%Domain) + call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file @@ -1281,9 +1295,9 @@ end subroutine initialize_velocity_from_file subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1312,12 +1326,13 @@ subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) end subroutine initialize_velocity_zero !> Sets the initial velocity components to uniform -subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_uniform(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1334,10 +1349,10 @@ subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "INITIAL_V_CONST", initial_v_const, & "A initial uniform value for the meridional flow.", & - units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + units="m s-1", scale=US%m_s_to_L_T, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1352,12 +1367,13 @@ end subroutine initialize_velocity_uniform !> Sets the initial velocity components to be circular with !! no flow at edges of domain and center. -subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) +subroutine initialize_velocity_circular(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< The zonal velocity that is being initialized [m s-1] + intent(out) :: u !< The zonal velocity that is being initialized [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< The meridional velocity that is being initialized [m s-1] + intent(out) :: v !< The meridional velocity that is being initialized [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1376,7 +1392,7 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the "// & "circular stream function [m s-1].", & - units="m s-1", default=0., do_not_log=just_read) + units="m s-1", default=0., scale=US%L_T_to_m_s, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1385,12 +1401,12 @@ subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) do k=1,nz ; do j=js,je ; do I=Isq,Ieq psi1 = my_psi(I,j) psi2 = my_psi(I,j-1) - u(I,j,k) = (psi1-psi2)/G%dy_Cu(I,j)! *(circular_max_u*G%len_lon/(2.0*dpi)) + u(I,j,k) = (psi1-psi2) / (G%US%L_to_m*G%dy_Cu(I,j)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie psi1 = my_psi(i,J) psi2 = my_psi(i-1,J) - v(i,J,k) = (psi2-psi1)/G%dx_Cv(i,J)! *(circular_max_u*G%len_lon/(2.0*dpi)) + v(i,J,k) = (psi2-psi1) / (G%US%L_to_m*G%dx_Cv(i,J)) ! *(circular_max_u*G%len_lon/(2.0*dpi)) enddo ; enddo ; enddo contains @@ -1402,12 +1418,12 @@ real function my_psi(ig,jg) ! Local variables real :: x, y, r - x = 2.0*(G%geoLonBu(ig,jg)-G%west_lon)/G%len_lon-1.0 ! -1 This subroutine sets the 4 bottom depths at velocity points to be the @@ -2156,7 +2172,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Compute fractional ice shelf coverage of h do j=jsd,jed ; do i=isd,ied if (G%areaT(i,j) > 0.0) & - frac_shelf_h(i,j) = area_shelf_h(i,j) / G%areaT(i,j) + frac_shelf_h(i,j) = area_shelf_h(i,j) / (US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ! Pass to the pointer for use as an argument to regridding_main shelf_area => frac_shelf_h @@ -2389,15 +2405,15 @@ subroutine MOM_state_init_tests(G, GV, US, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*(GV%g_Earth*US%m_to_Z)*z(k), & + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%mks_g_Earth*z(k), & rho(k), tv%eqn_of_state) - P_tot = P_tot + (GV%g_Earth*US%m_to_Z) * rho(k) * h(k) + P_tot = P_tot + GV%mks_g_Earth * rho(k) * h(k) enddo P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), & - P_t, 0.5*P_tot, GV%Rho0, (GV%g_Earth*US%m_to_Z), tv%eqn_of_state, P_b, z_out) + P_t, 0.5*P_tot, GV%Rho0, GV%mks_g_Earth, tv%eqn_of_state, P_b, z_out) write(0,*) k,P_t,P_b,0.5*P_tot,e(K),e(K+1),z_out P_t = P_b enddo @@ -2407,7 +2423,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) write(0,*) ' ==================================================================== ' write(0,*) '' write(0,*) h - call cut_off_column_top(nk, tv, GV, (GV%g_Earth*US%m_to_Z), -e(nk+1), GV%Angstrom_H, & + call cut_off_column_top(nk, tv, GV, GV%mks_g_Earth, -e(nk+1), GV%Angstrom_H, & T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) write(0,*) h diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 27dde7f69d..74afd4868a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -222,8 +222,8 @@ subroutine init_oda(Time, G, GV, CS) dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) call MOM_grid_init(CS%Grid, PF, global_indexing=.true.) - call ALE_updateVerticalGridType(CS%ALE_CS,CS%GV) - call copy_dyngrid_to_MOM_grid(dG, CS%Grid) + call ALE_updateVerticalGridType(CS%ALE_CS, CS%GV) + call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) CS%mpp_domain => CS%Grid%Domain%mpp_domain CS%Grid%ke = CS%GV%ke CS%nk = CS%GV%ke diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 3688c3dfea..5034ad0f24 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -9,9 +9,7 @@ module MOM_MEKE 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_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_domains, only : create_group_pass, do_group_pass -use MOM_domains, only : group_pass_type -use MOM_domains, only : pass_var, pass_vector +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, MOM_mesg use MOM_file_parser, only : read_param, get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -35,7 +33,7 @@ module MOM_MEKE real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE [nondim] real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE [nondim] real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] - real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [s-1]. + real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [T-1 ~> s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 !! to account for the surface intensification of MEKE. @@ -54,12 +52,12 @@ module MOM_MEKE logical :: use_old_lscale !< Use the old formula for mixing length scale. logical :: use_min_lscale !< Use simple minimum for mixing length scale. real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. - real :: MEKE_BGsrc !< Background energy source for MEKE [W kg-1] (= m2 s-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] - real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [m s-1] - real :: MEKE_KH !< Background lateral diffusion of MEKE [m2 s-1] - real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [m4 s-1] + real :: MEKE_Uscale !< MEKE velocity scale for bottom drag [L T-1 ~> m s-1] + real :: MEKE_KH !< Background lateral diffusion of MEKE [L2 T-1 ~> m2 s-1] + real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) [L4 T-1 ~> m4 s-1] real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for !! MEKE itself [nondim]. real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for @@ -68,7 +66,7 @@ module MOM_MEKE real :: viscosity_coeff_Au !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral biharmonic momentum mixing !! by unresolved eddies represented by MEKE. - real :: Lfixed !< Fixed mixing length scale [m]. + real :: Lfixed !< Fixed mixing length scale [L ~> m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] real :: aFrict !< Weighting towards frictional arrest scale of mixing length [nondim] @@ -81,9 +79,6 @@ module MOM_MEKE logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. logical :: debug !< If true, write out checksums of data for debugging - ! Optional storage - real, dimension(:,:), allocatable :: del2MEKE !< Laplacian of MEKE, used for bi-harmonic diffusion. - type(diag_ctrl), pointer :: diag => NULL() !< A type that regulates diagnostics output !>@{ Diagnostic handles integer :: id_MEKE = -1, id_Ue = -1, id_Kh = -1, id_src = -1 @@ -96,12 +91,8 @@ module MOM_MEKE ! Infrastructure integer :: id_clock_pass !< Clock for group pass calls - type(group_pass_type) :: pass_MEKE !< Type for group halo pass calls - type(group_pass_type) :: pass_Kh !< Type for group halo pass calls - type(group_pass_type) :: pass_Kh_diff !< Type for group halo pass calls - type(group_pass_type) :: pass_Ku !< Type for group halo pass calls - type(group_pass_type) :: pass_Au !< Type for group halo pass calls - type(group_pass_type) :: pass_del2MEKE !< Type for group halo pass calls + type(group_pass_type) :: pass_MEKE !< Group halo pass handle for MEKE%MEKE and maybe MEKE%Kh_diff + type(group_pass_type) :: pass_Kh !< Group halo pass handle for MEKE%Kh, MEKE%Ku, and/or MEKE%Au end type MEKE_CS contains @@ -114,49 +105,59 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h 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_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: SN_v !< Eady growth rate at v-points [s-1]. + 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]. type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [s]. type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & mass, & ! The total mass of the water column [kg m-2]. I_mass, & ! The inverse of mass [m2 kg-1]. - src, & ! The sum of all MEKE sources [m2 s-3]. - MEKE_decay, & ! The MEKE decay timescale [s-1]. - MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. - MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. - MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. - drag_rate_visc, & - drag_rate, & ! The MEKE spindown timescale due to bottom drag [s-1]. - LmixScale, & ! Square of eddy mixing length [m2]. + 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]. + ! MEKE_GM_src, & ! The MEKE source from thickness mixing [m2 s-3]. + ! MEKE_mom_src, & ! The MEKE source from momentum [m2 s-3]. + ! MEKE_GME_snk, & ! The MEKE sink from GME backscatter [m2 s-3]. + drag_rate_visc, & ! Near-bottom velocity contribution to bottom dratg [L T-1 ~> m s-1] + drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. + drag_rate_J15, & ! The MEKE spindown timescale due to bottom drag with the Jansen 2015 scheme. + ! Unfortunately, as written the units seem inconsistent. [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]. + LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2 ! Ratio of EKE_bottom / EKE [nondim] real, dimension(SZIB_(G),SZJ_(G)) :: & - MEKE_uflux, & ! The zonal diffusive flux of MEKE [kg m2 s-3]. - Kh_u, & ! The zonal diffusivity that is actually used [m2 s-1]. - baroHu, & ! Depth integrated zonal mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + MEKE_uflux, & ! The zonal advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHu, & ! Depth integrated accumulated zonal mass flux [H L2 ~> m3 or kg]. drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points [m s-1]. + ! u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - MEKE_vflux, & ! The meridional diffusive flux of MEKE [kg m2 s-3]. - Kh_v, & ! The meridional diffusivity that is actually used [m2 s-1]. - baroHv, & ! Depth integrated meridional mass flux [H m2 s-1 ~> m3 s-1 or kg s-1]. + MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with different units in different + ! places of [L2 T-2 ~> m2 s-2] or [m L4 T-3 ~> m5 s-3] or [kg m-2 L4 T-3 ~> kg m-2 s-3]. + Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. + baroHv, & ! Depth integrated accumulated meridional mass flux [H L2 ~> m3 or kg]. drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points [m s-1]. - real :: Kh_here, Inv_Kh_max, K4_here + ! v-points [Z T-1 ~> m 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 - real :: advFac + real :: advFac ! The product of the advection scaling factor and some unit conversion + ! factors divided by the timestep [m H-1 T-1 ~> s-1 or m3 kg-1 s-1] real :: mass_neglect ! A negligible mass [kg m-2]. - real :: ldamping ! The MEKE damping rate [s-1]. + real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. real :: Rho0 ! A density used to convert mass to distance [kg m-3]. - real :: sdt ! dt to use locally [s] (could be scaled to accelerate) - real :: sdt_damp ! dt for damping [s] (sdt could be split). + 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 integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -168,10 +169,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (.not.associated(MEKE)) call MOM_error(FATAL, & "MOM_MEKE: MEKE must be initialized before it is used.") - Rho0 = GV%H_to_kg_m2 * GV%m_to_H - mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping - if (CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0 .or. CS%MEKE_Cb>0. & + if ((CS%MEKE_damping > 0.0) .or. (CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & .or. CS%visc_drag) then use_drag_rate = .true. else @@ -179,19 +177,24 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif ! Only integrate the MEKE equations if MEKE is required. - if (associated(MEKE%MEKE)) then + if (.not.associated(MEKE%MEKE)) then +! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") + return + endif if (CS%debug) then - if (associated(MEKE%mom_src)) call hchksum(MEKE%mom_src, 'MEKE mom_src',G%HI) - if (associated(MEKE%GME_snk)) call hchksum(MEKE%GME_snk, 'MEKE GME_snk',G%HI) - if (associated(MEKE%GM_src)) call hchksum(MEKE%GM_src, 'MEKE GM_src',G%HI) - if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE',G%HI) - call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) + if (associated(MEKE%mom_src)) & + call hchksum(MEKE%mom_src, 'MEKE mom_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GME_snk)) & + call hchksum(MEKE%GME_snk, 'MEKE GME_snk', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%GM_src)) & + call hchksum(MEKE%GM_src, 'MEKE GM_src', G%HI, scale=US%L_to_m**2*US%s_to_T**3) + if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) + call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T) call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) endif - ! Why are these 3 lines repeated from above? - sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + sdt = US%s_to_T*dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping Rho0 = GV%H_to_kg_m2 * GV%m_to_H mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff cdrag2 = CS%cdrag**2 @@ -223,7 +226,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then !$OMP parallel do default(shared) private(ldamping) do j=js,je ; do i=is,ie - drag_rate(i,j) = 0. + drag_rate(i,j) = 0. ; drag_rate_J15(i,j) = 0. enddo ; enddo endif @@ -233,18 +236,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = US%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = US%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * US%Z_to_L * & ((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) + & @@ -277,12 +280,12 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Calculates bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then - call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI) + call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, scale=US%Z_to_m*US%s_to_T) call hchksum(mass, 'MEKE mass',G%HI,haloshift=1) - call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI) + call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI, scale=US%L_T_to_m_s) call hchksum(bottomFac2, 'MEKE bottomFac2',G%HI) call hchksum(barotrFac2, 'MEKE barotrFac2',G%HI) - call hchksum(LmixScale, 'MEKE LmixScale',G%HI) + call hchksum(LmixScale, 'MEKE LmixScale',G%HI,scale=US%L_to_m) endif ! Aggregate sources of MEKE (background, frictional and GM) @@ -299,19 +302,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif if (associated(MEKE%GME_snk)) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMECoeff*I_mass(i,j)*MEKE%GME_snk(i,j) enddo ; enddo endif if (associated(MEKE%GM_src)) then -!$OMP do if (CS%GM_src_alt) then + !$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) / MAX(1.0,G%bathyT(i,j)) + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & + MAX(1.0, G%bathyT(i,j)) !### 1.0 seems to be a hard-coded dimensional constant (1 m?). enddo ; enddo else + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) enddo ; enddo @@ -321,31 +326,31 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! Increase EKE by a full time-steps worth of source !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j) )*G%mask2dT(i,j) + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j))*G%mask2dT(i,j) enddo ; enddo if (use_drag_rate) then ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * 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 ) ) + drag_rate(i,j) = (US%L_to_m*Rho0 * 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 ! First stage of Strang splitting -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. ! notice that the above line ensures a damping only if MEKE is positive, ! while leaving MEKE unchanged if it is negative MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo -!$OMP end parallel - if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_K4 >= 0.0) then - ! Update halos for lateral or bi-harmonic diffusion + + if (CS%kh_flux_enabled .or. CS%MEKE_K4 >= 0.0) then + ! Update MEKE in the halos for lateral or bi-harmonic diffusion 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) @@ -354,7 +359,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then ! Calculate Laplacian of MEKE !$OMP parallel do default(shared) - do j=js,je ; do I=is-1,ie + do j=js-1,je+1 ; do I=is-2,ie+1 + ! Here the units of MEKE_uflux are [L2 T-2]. MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -362,72 +368,75 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) enddo ; enddo !$OMP parallel do default(shared) - do J=js-1,je ; do i=is,ie + do J=js-2,je+1 ; do i=is-1,ie+1 + ! Here the units of MEKE_vflux are [L2 T-2]. MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) enddo ; enddo + !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - CS%del2MEKE(i,j) = G%IareaT(i,j) * & + do j=js-1,je+1 ; do i=is-1,ie+1 + del2MEKE(i,j) = G%IareaT(i,j) * & ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) - ! CS%del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & + ! del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & ! ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) enddo ; enddo - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_del2MEKE, G%Domain) - call cpu_clock_end(CS%id_clock_pass) ! Bi-harmonic diffusion of MEKE - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do j=js,je ; do I=is-1,ie K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. - Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))))**2.0 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + max(G%IareaT(i,j), G%IareaT(i+1,j)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max + ! Here the units of MEKE_uflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & - (CS%del2MEKE(i+1,j) - CS%del2MEKE(i,j)) + (del2MEKE(i+1,j) - del2MEKE(i,j)) enddo ; enddo - !$OMP parallel do default(shared) private(K4_here,Inv_Kh_max) + !$OMP parallel do default(shared) private(K4_here,Inv_K4_max) do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 - Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))))**2.0 - if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + Inv_K4_max = 64.0 * sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j), G%IareaT(i,j+1)))**2 + if (K4_here*Inv_K4_max > 0.3) K4_here = 0.3 / Inv_K4_max MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & - (CS%del2MEKE(i,j+1) - CS%del2MEKE(i,j)) + (del2MEKE(i,j+1) - del2MEKE(i,j)) enddo ; enddo + ! Store tendency arising from the bi-harmonic in del4MEKE !$OMP parallel do default(shared) - ! Store tendency of bi-harmonic in del2MEKE do j=js,je ; do i=is,ie - CS%del2MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + del4MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) enddo ; enddo endif ! + if (CS%kh_flux_enabled) then ! Lateral diffusion of MEKE - Kh_here = max(0.,CS%MEKE_Kh) + Kh_here = max(0., CS%MEKE_Kh) !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do j=js,je ; do I=is-1,ie ! Limit Kh to avoid CFL violations. if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + Kh_here = max(0., CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) + Kh_here = max(0.,CS%MEKE_Kh) + & + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i+1,j)) Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & max(G%IareaT(i,j),G%IareaT(i+1,j))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_u(I,j) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) @@ -435,22 +444,25 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) firstprivate(Kh_here) private(Inv_Kh_max) do J=js-1,je ; do i=is,ie if (associated(MEKE%Kh)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) if (associated(MEKE%Kh_diff)) & - Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) - Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))) + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac * 0.5*(MEKE%Kh_diff(i,j)+MEKE%Kh_diff(i,j+1)) + Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * max(G%IareaT(i,j),G%IareaT(i,j+1))) if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max Kh_v(i,J) = Kh_here + ! Here the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) enddo ; enddo if (CS%MEKE_advection_factor>0.) then - advFac = GV%H_to_m * CS%MEKE_advection_factor / dt + !### I think that for dimensional consistency, this should be: + ! advFac = GV%H_to_kg_m2 * CS%MEKE_advection_factor / (US%s_to_T*dt) + advFac = GV%H_to_m * CS%MEKE_advection_factor / (US%s_to_T*dt) !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHu(I,j)>0.) then MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac elseif (baroHu(I,j)<0.) then @@ -459,6 +471,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie + ! Here the units of the quantities added to MEKE_uflux and MEKE_vflux are [m L4 T-3]. if (baroHv(i,J)>0.) then MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac elseif (baroHv(i,J)<0.) then @@ -466,8 +479,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif enddo ; enddo endif + + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie + ! This expression is correct if the units of MEKE_uflux and MEKE_vflux are [kg m-2 L4 T-3]. MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) @@ -478,7 +494,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%MEKE_K4 >= 0.0) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + CS%del2MEKE(i,j) + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + del4MEKE(i,j) enddo ; enddo endif @@ -487,21 +503,21 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (sdt>sdt_damp) then ! Recalculate the drag rate, since MEKE has changed. if (use_drag_rate) then -!$OMP do + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - drag_rate(i,j) = (Rho0 * 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 ) ) + drag_rate(i,j) = (US%L_to_m*Rho0 * 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 + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) - if (MEKE%MEKE(i,j)<0.) ldamping = 0. + if (MEKE%MEKE(i,j) < 0.) ldamping = 0. ! notice that the above line ensures a damping only if MEKE is positive, ! while leaving MEKE unchanged if it is negative MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) enddo ; enddo endif -!$OMP do endif endif ! MEKE_KH>=0 @@ -509,7 +525,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) ! enddo ; enddo -!$OMP end parallel 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) @@ -521,48 +536,46 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h if (CS%Rd_as_max_scale) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & - * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & - * min(MEKE%Rd_dx_h(i,j), 1.0) + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff * & + sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) ) * & + min(MEKE%Rd_dx_h(i,j), 1.0) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) enddo ; enddo endif else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) + MEKE%Kh(i,j) = CS%MEKE_KhCoeff * & + sqrt(2.*max(0., barotrFac2(i,j)*MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo endif - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Kh, G%Domain) - call cpu_clock_end(CS%id_clock_pass) - endif + endif endif ! Calculate viscosity for the main model to use if (CS%viscosity_coeff_Ku /=0.) then do j=js,je ; do i=is,ie - MEKE%Ku(i,j) = CS%viscosity_coeff_Ku*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + MEKE%Ku(i,j) = CS%viscosity_coeff_Ku * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j) enddo ; enddo - call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Ku, G%Domain) - call cpu_clock_end(CS%id_clock_pass) endif if (CS%viscosity_coeff_Au /=0.) then do j=js,je ; do i=is,ie - MEKE%Au(i,j) = CS%viscosity_coeff_Au*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j)**3 + MEKE%Au(i,j) = CS%viscosity_coeff_Au * sqrt(2.*max(0.,MEKE%MEKE(i,j))) * LmixScale(i,j)**3 enddo ; enddo + endif + + if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) then call cpu_clock_begin(CS%id_clock_pass) - call do_group_pass(CS%pass_Au, G%Domain) + call do_group_pass(CS%pass_Kh, G%Domain) call cpu_clock_end(CS%id_clock_pass) endif - ! Offer fields for averaging. if (CS%id_MEKE>0) call post_data(CS%id_MEKE, MEKE%MEKE, CS%diag) if (CS%id_Ue>0) call post_data(CS%id_Ue, sqrt(max(0.,2.0*MEKE%MEKE)), CS%diag) @@ -592,10 +605,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call post_data(CS%id_gamma_t, barotrFac2, CS%diag) endif -! else ! if MEKE%MEKE -! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") - endif - end subroutine step_forward_MEKE !> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity @@ -606,17 +615,28 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m 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), pointer :: CS !< MEKE control structure. - type(MEKE_type), pointer :: MEKE !< MEKE data. - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [s-1]. - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [s-1]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. + type(MEKE_type), pointer :: MEKE !< A structure with MEKE data. + 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] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass [m2 kg-1]. ! Local variables - real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady - real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src - real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr - real :: FatH ! Coriolis parameter at h points; to compute topographic beta [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real :: beta ! Combined topograpic 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, KhCoeff + 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 + 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]. + real :: EKE, EKEmin, EKEmax, EKEerr ! [L2 T-2 ~> m2 s-2] + 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] integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket [m2 s-2]. logical :: useSecant, debugIteration @@ -630,83 +650,75 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m !$OMP do do j=js,je ; do i=is,ie - !SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) + ! 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( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) + SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - FatH = 0.25*US%s_to_T*((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 + 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 ! Since zero-bathymetry cells are masked, this avoids calculations on land if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then beta_topo_x = 0. ; beta_topo_y = 0. else - !### These expressions should be recast to use a single division, but it will change answers. - !beta_topo_x = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) - !beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + !### Consider different combinations of these estimates of topographic beta, and the use + ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + / max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) - - I_H = GV%Rho0 * I_mass(i,j) + I_H = US%L_to_m*GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>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 - EKEmax = 0.01 ! First guess at right bracket + EKEmax = 0.01*US%m_s_to_L_T**2 ! First guess at right bracket useSecant = .false. ! Start using a bisection method ! First find right bracket for which resid<0 - resid = 1. ; n1 = 0 + resid = 1.0*US%m_to_L**2*US%T_to_s**3 ; n1 = 0 do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, EKE, US%Z_to_m, & - bottomFac2, barotrFac2, LmixScale, & - Lrhines, Leady) + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, EKE, & + bottomFac2, barotrFac2, LmixScale, LRhines, LEady) ! 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 = I_H * 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 - write(0,*) n1, 'EKE=',EKE,'resid=',resid - write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin - write(0,*) 'src=',src,'ldamping=',ldamping - write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 - write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 - endif + ! if (debugIteration) then + ! write(0,*) n1, 'EKE=',EKE,'resid=',resid + ! write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin + ! write(0,*) 'src=',src,'ldamping=',ldamping + ! write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 + ! write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 + ! endif if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here EKEmax = 10. * EKE ! and guess again for the right bracket if (resid 2.e17) then + if (US%L_T_to_m_s**2*EKEmax > 2.e17) then if (debugIteration) stop 'Something has gone very wrong' debugIteration = .true. resid = 1. ; n1 = 0 EKEmin = 0. ; ResMin = 0. - EKEmax = 0.01 + EKEmax = 0.01*US%m_s_to_L_T**2 useSecant = .false. endif endif @@ -715,7 +727,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m ! Bisect the bracket n2 = 0 ; EKEerr = EKEmax - EKEmin - do while (EKEerr>tolerance) + do while (US%L_T_to_m_s**2*EKEerr>tolerance) n2 = n2 + 1 if (useSecant) then EKE = EKEmin + (EKEmax - EKEmin) * (ResMin / (ResMin - ResMax)) @@ -729,7 +741,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m drag_rate = I_H * 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. + if (useSecant .and. resid>ResMin) useSecant = .false. if (resid>0.) then ! EKE is to the left of the root EKEmin = EKE ! so we move the left bracket here if (resid 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(out) :: bottomFac2 !< gamma_b^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN - real :: FatH ! Coriolis parameter at h points [s-1] - real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [s-1 m-1] + real, dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady ! Possible mixing length scales [L ~> m] + real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + 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] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -785,12 +798,12 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & do j=js,je ; do i=is,ie if (.not.CS%use_old_lscale) then if (CS%aEady > 0.) then - SN = 0.25*( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) + SN = 0.25 * ( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)) ) else SN = 0. endif - FatH = 0.25*US%s_to_T* ( ( 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 + 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 ! If bathyT is zero, then a division by zero FPE will be raised. In this ! case, we apply Adcroft's rule of reciprocals and set the term to zero. @@ -798,70 +811,65 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.0) then beta_topo_x = 0. ; beta_topo_y = 0. else - !### These expressions should be recast to use a single division, but it will change answers. - !beta_topo_x = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) * G%IdxT(i,j) / G%bathyT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH & - ! * 0.5 * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) * G&IdxT(i,j) / G%bathyT(i,j) - !beta_topo_x = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i+1,j) - G%bathyT(i-1,j)) / 2. / G%dxT(i,j) - !beta_topo_y = CS%MEKE_topographic_beta * FatH / G%bathyT(i,j) & - ! * (G%bathyT(i,j+1) - G%bathyT(i,j-1)) / 2. / G%dyT(i,j) + !### Consider different combinations of these estimates of topographic beta, and the use + ! of the water column thickness instead of the bathymetric depth. beta_topo_x = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i+1,j)-G%bathyT(i,j)) * G%IdxCu(I,j) & - /max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + / max(G%bathyT(i+1,j),G%bathyT(i,j), GV%H_subroundoff) & + (G%bathyT(i,j)-G%bathyT(i-1,j)) * G%IdxCu(I-1,j) & - /max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i-1,j), GV%H_subroundoff) ) + !### There is a bug in the 4th lne below, where IdxCu should be IdyCv. beta_topo_y = CS%MEKE_topographic_beta * FatH * 0.5 * ( & (G%bathyT(i,j+1)-G%bathyT(i,j)) * G%IdyCv(i,J) & - /max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & + / max(G%bathyT(i,j+1),G%bathyT(i,j), GV%H_subroundoff) + & (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdxCu(i,J-1) & - /max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) endif - - beta = sqrt((US%s_to_T * G%dF_dx(i,j) - beta_topo_x)**2 & - + (US%s_to_T * G%dF_dy(i,j) - beta_topo_y)**2 ) + beta = sqrt((G%dF_dx(i,j) - beta_topo_x)**2 + & + (G%dF_dy(i,j) - beta_topo_y)**2 ) else beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & - MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), US%Z_to_m, & + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & - Lrhines(i,j), Leady(i,j)) + LRhines(i,j), LEady(i,j)) enddo ; enddo - if (CS%id_Lrhines>0) call post_data(CS%id_Lrhines, Lrhines, CS%diag) - if (CS%id_Leady>0) call post_data(CS%id_Leady, Leady, CS%diag) + if (CS%id_Lrhines>0) call post_data(CS%id_LRhines, LRhines, CS%diag) + if (CS%id_Leady>0) call post_data(CS%id_LEady, LEady, CS%diag) 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, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & +subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), pointer :: CS !< MEKE control structure. - real, intent(in) :: area !< Grid cell area [m2] - real, intent(in) :: beta !< Planetary beta = |grad F| [s-1 m-1] + 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 = |grad F| [T-1 L-1 ~> s-1 m-1] real, intent(in) :: depth !< Ocean depth [Z ~> m] real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. - real, intent(in) :: SN !< Eady growth rate [s-1]. - real, intent(in) :: EKE !< Eddy kinetic energy [m s-1]. - real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to - !! the units for lateral distances (L). + real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1]. + real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. +! real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to +! !! the units for lateral distances (L). real, intent(out) :: bottomFac2 !< gamma_b^2 real, intent(out) :: barotrFac2 !< gamma_t^2 - real, intent(out) :: LmixScale !< Eddy mixing length [m]. - real, intent(out) :: Lrhines !< Rhines length scale [m]. - real, intent(out) :: Leady !< Eady length scale [m]. + real, intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. + real, intent(out) :: Lrhines !< Rhines length scale [L ~> m]. + real, intent(out) :: Leady !< Eady length scale [L ~> m]. ! Local variables - real :: Lgrid, Ldeform, LdeformLim, Ue, Lfrict + real :: Lgrid, Ldeform, Lfrict ! Length scales [L ~> m] + real :: Ue ! An eddy velocity [L T-1 ~> m s-1] ! Length scale for MEKE derived diffusivity Lgrid = sqrt(area) ! Grid scale Ldeform = Lgrid * Rd_dx ! Deformation scale - Lfrict = (Z_to_L * depth) / CS%cdrag ! Frictional arrest scale + Lfrict = (US%Z_to_L * depth) / 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 @@ -870,7 +878,7 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & ! gamma_t^2 is the ratio of barotropic eddy energy to mean column eddy energy ! used in the velocity scale for diffusivity barotrFac2 = 1. - if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1./( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 + if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1. / ( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 barotrFac2 = max(barotrFac2, CS%MEKE_min_gamma) if (CS%use_old_lscale) then if (CS%Rd_as_max_scale) then @@ -880,9 +888,9 @@ subroutine MEKE_lengthScales_0d(CS, area, beta, depth, Rd_dx, SN, EKE, Z_to_L, & endif else Ue = sqrt( 2.0 * max( 0., barotrFac2*EKE ) ) ! Barotropic eddy flow scale - Lrhines = sqrt( Ue / max( beta, 1.e-30 ) ) ! Rhines scale + Lrhines = sqrt( Ue / max( beta, 1.e-30*US%T_to_s*US%L_to_m ) ) ! Rhines scale if (CS%aEady > 0.) then - Leady = Ue / max( SN, 1.e-15 ) ! Bound Eady time-scale < 1e15 seconds + Leady = Ue / max( SN, 1.e-15*US%T_to_s ) ! Bound Eady time-scale < 1e15 seconds else Leady = 0. endif @@ -910,22 +918,28 @@ 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, param_file, diag, CS, MEKE, restart_CS) +logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) type(time_type), intent(in) :: Time !< The current model time. 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 !< Parameter file parser structure. type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE-related fields. type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. -! Local variables - integer :: is, ie, js, je, isd, ied, jsd, jed, nz + + ! Local variables + real :: I_T_rescale ! A rescaling factor for time from the internal representation in this + ! run to the representation in a restart file. + real :: L_rescale ! A rescaling factor for length from the internal representation in this + ! run to the representation in a restart file. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed logical :: laplacian, biharmonic, useVarMix, coldStart -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_MEKE" ! This module's name. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ! Determine whether this module will be used @@ -953,7 +967,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "MEKE_DAMPING", CS%MEKE_damping, & "The local depth-independent MEKE dissipation rate.", & - units="s-1", default=0.0) + units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & "The ratio of the bottom eddy velocity to the column mean "//& "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//& @@ -991,15 +1005,15 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & - default=0.0) + default=0.0, scale=US%m_to_L**2*US%T_to_s**3) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & - units="m2 s-1", default=-1.0) + units="m2 s-1", default=-1.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "MEKE_K4", CS%MEKE_K4, & "A lateral bi-harmonic diffusivity of MEKE. "//& "Use a negative value to not apply bi-harmonic diffusion to MEKE.", & - units="m4 s-1", default=-1.0) + units="m4 s-1", default=-1.0, scale=US%m_to_L**4*US%T_to_s) 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) @@ -1012,7 +1026,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) units="nondim", default=1.0) call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & "The background velocity that is combined with MEKE to "//& - "calculate the bottom drag.", units="m s-1", default=0.0) + "calculate the bottom drag.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%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.", default=.false.) @@ -1055,7 +1069,7 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & "If positive, is a fixed length contribution to the expression "//& "for mixing length used in MEKE-derived diffusivity.", & - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & "If positive, is a coefficient weighting the deformation scale "//& "in the expression for mixing length used in MEKE-derived diffusivity.", & @@ -1113,86 +1127,53 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) - ! Allocation of storage NOT shared with other modules - if (CS%MEKE_K4>=0.) then - allocate(CS%del2MEKE(isd:ied,jsd:jed)) ; CS%del2MEKE(:,:) = 0.0 - endif - ! Identify if any lateral diffusive processes are active CS%kh_flux_enabled = .false. - if (CS%MEKE_KH >= 0.0 & - .or. CS%KhMEKE_FAC > 0.0 & - .or. CS%MEKE_advection_factor >0.0) & + if ((CS%MEKE_KH >= 0.0) .or. (CS%KhMEKE_FAC > 0.0) .or. (CS%MEKE_advection_factor > 0.0)) & CS%kh_flux_enabled = .true. -! In the case of a restart, these fields need a halo update - if (associated(MEKE%MEKE)) then - call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) - call do_group_pass(CS%pass_MEKE, G%Domain) - endif - if (associated(MEKE%Kh)) then - call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) - call do_group_pass(CS%pass_Kh, G%Domain) - endif - if (associated(MEKE%Kh_diff)) then - call create_group_pass(CS%pass_Kh_diff, MEKE%Kh_diff, G%Domain) - call do_group_pass(CS%pass_Kh_diff, G%Domain) - endif - if (associated(MEKE%Ku)) then - call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) - call do_group_pass(CS%pass_Ku, G%Domain) - endif - if (associated(MEKE%Au)) then - call create_group_pass(CS%pass_Au, MEKE%Au, G%Domain) - call do_group_pass(CS%pass_Au, G%Domain) - endif - if (allocated(CS%del2MEKE)) then - call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) - call do_group_pass(CS%pass_del2MEKE, G%Domain) - endif - ! Register fields for output from this module. CS%diag => diag CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & - 'Mesoscale Eddy Kinetic Energy', 'm2 s-2') + 'Mesoscale Eddy Kinetic Energy', 'm2 s-2', conversion=US%L_T_to_m_s**2) if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & - 'MEKE derived diffusivity', 'm2 s-1') + 'MEKE derived diffusivity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & - 'MEKE derived lateral viscosity', 'm2 s-1') + 'MEKE derived lateral viscosity', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 CS%id_Au = register_diag_field('ocean_model', 'MEKE_AU', diag%axesT1, Time, & - 'MEKE derived lateral biharmonic viscosity', 'm4 s-1') + 'MEKE derived lateral biharmonic viscosity', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) if (.not. associated(MEKE%Au)) CS%id_Au = -1 CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & - 'MEKE derived eddy-velocity scale', 'm s-1') + 'MEKE derived eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & - 'MEKE derived bottom eddy-velocity scale', 'm s-1') + 'MEKE derived bottom eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & - 'MEKE derived barotropic eddy-velocity scale', 'm s-1') + 'MEKE derived barotropic eddy-velocity scale', 'm s-1', conversion=US%L_T_to_m_s) if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & 'MEKE energy source', 'm2 s-3') CS%id_decay = register_diag_field('ocean_model', 'MEKE_decay', diag%axesT1, Time, & - 'MEKE decay rate', 's-1') + 'MEKE decay rate', 's-1', conversion=US%s_to_T) CS%id_GM_src = register_diag_field('ocean_model', 'MEKE_GM_src', diag%axesT1, Time, & - 'MEKE energy available from thickness mixing', 'W m-2') + 'MEKE energy available from thickness mixing', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GM_src)) CS%id_GM_src = -1 CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & - 'MEKE energy available from momentum', 'W m-2') + 'MEKE energy available from momentum', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 CS%id_GME_snk = register_diag_field('ocean_model', 'MEKE_GME_snk',diag%axesT1, Time, & - 'MEKE energy lost to GME backscatter', 'W m-2') + 'MEKE energy lost to GME backscatter', 'W m-2', conversion=US%L_to_m**2*US%s_to_T**3) if (.not. associated(MEKE%GME_snk)) CS%id_GME_snk = -1 CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & - 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') + 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & - 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm') + 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_Leady = register_diag_field('ocean_model', 'MEKE_Leady', diag%axesT1, Time, & - 'Eady length scale used in the MEKE derived eddy diffusivity', 'm') + 'Eady length scale used in the MEKE derived eddy diffusivity', 'm', conversion=US%L_to_m) CS%id_gamma_b = register_diag_field('ocean_model', 'MEKE_gamma_b', diag%axesT1, Time, & 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity', 'nondim') CS%id_gamma_t = register_diag_field('ocean_model', 'MEKE_gamma_t', diag%axesT1, Time, & @@ -1200,21 +1181,75 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) if (CS%kh_flux_enabled) then CS%id_KhMEKE_u = register_diag_field('ocean_model', 'KHMEKE_u', diag%axesCu1, Time, & - 'Zonal diffusivity of MEKE', 'm2 s-1') + 'Zonal diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhMEKE_v = register_diag_field('ocean_model', 'KHMEKE_v', diag%axesCv1, Time, & - 'Meridional diffusivity of MEKE', 'm2 s-1') + 'Meridional diffusivity of MEKE', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) endif CS%id_clock_pass = cpu_clock_id('(Ocean continuity halo updates)', grain=CLOCK_ROUTINE) - ! Detect whether this instant of MEKE_init() is at the beginning of a run + ! Detect whether this instance of MEKE_init() is at the beginning of a run ! or after a restart. If at the beginning, we will initialize MEKE to a local ! equilibrium. - CS%initialize = .not.query_initialized(MEKE%MEKE,"MEKE",restart_CS) + CS%initialize = .not.query_initialized(MEKE%MEKE, "MEKE", restart_CS) if (coldStart) CS%initialize = .false. if (CS%initialize) call MOM_error(WARNING, & "MEKE_init: Initializing MEKE with a local equilibrium balance.") + ! Account for possible changes in dimensional scaling for variables that have been + ! read from a restart file. + I_T_rescale = 1.0 + if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & + I_T_rescale = US%s_to_T_restart / US%s_to_T + L_rescale = 1.0 + if ((US%m_to_L_restart /= 0.0) .and. (US%m_to_L_restart /= US%m_to_L)) & + L_rescale = US%m_to_L / US%m_to_L_restart + + if (L_rescale*I_T_rescale /= 1.0) then + if (associated(MEKE%MEKE)) then ; if (query_initialized(MEKE%MEKE, "MEKE_MEKE", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = L_rescale*I_T_rescale * MEKE%MEKE(i,j) + enddo ; enddo + endif ; endif + endif + if (L_rescale**2*I_T_rescale /= 1.0) then + if (associated(MEKE%Kh)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh(i,j) + enddo ; enddo + endif ; endif + if (associated(MEKE%Ku)) then ; if (query_initialized(MEKE%Ku, "MEKE_Ku", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Ku(i,j) = L_rescale**2*I_T_rescale * MEKE%Ku(i,j) + enddo ; enddo + endif ; endif + if (associated(MEKE%Kh_diff)) then ; if (query_initialized(MEKE%Kh, "MEKE_Kh_diff", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Kh_diff(i,j) = L_rescale**2*I_T_rescale * MEKE%Kh_diff(i,j) + enddo ; enddo + endif ; endif + endif + if (L_rescale**4*I_T_rescale /= 1.0) then + if (associated(MEKE%Au)) then ; if (query_initialized(MEKE%Au, "MEKE_Au", restart_CS)) then + do j=js,je ; do i=is,ie + MEKE%Au(i,j) = L_rescale**4*I_T_rescale * MEKE%Au(i,j) + enddo ; enddo + endif ; endif + endif + + ! Set up group passes. In the case of a restart, these fields need a halo update now. + if (associated(MEKE%MEKE)) then + call create_group_pass(CS%pass_MEKE, MEKE%MEKE, G%Domain) + if (associated(MEKE%Kh_diff)) call create_group_pass(CS%pass_MEKE, MEKE%Kh_diff, G%Domain) + if (.not.CS%initialize) call do_group_pass(CS%pass_MEKE, G%Domain) + endif + if (associated(MEKE%Kh)) call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + if (associated(MEKE%Ku)) call create_group_pass(CS%pass_Kh, MEKE%Ku, G%Domain) + if (associated(MEKE%Au)) call create_group_pass(CS%pass_Kh, MEKE%Au, G%Domain) + + if (associated(MEKE%Kh) .or. associated(MEKE%Ku) .or. associated(MEKE%Au)) & + call do_group_pass(CS%pass_Kh, G%Domain) + end function MEKE_init !> Allocates memory and register restart fields for the MOM_MEKE module. @@ -1269,7 +1304,7 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) endif if (MEKE_KhCoeff>=0.) then allocate(MEKE%Kh(isd:ied,jsd:jed)) ; MEKE%Kh(:,:) = 0.0 - vd = var_desc("MEKE_Kh", "m2 s-1",hor_grid='h',z_grid='1', & + vd = var_desc("MEKE_Kh", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral diffusivity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Kh, vd, .false., restart_CS) endif @@ -1314,7 +1349,6 @@ subroutine MEKE_end(MEKE, CS) if (associated(MEKE%Kh_diff)) deallocate(MEKE%Kh_diff) if (associated(MEKE%Ku)) deallocate(MEKE%Ku) if (associated(MEKE%Au)) deallocate(MEKE%Au) - if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) deallocate(MEKE) end subroutine MEKE_end diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 95106f1fdb..33f8f5d1b2 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -8,18 +8,20 @@ module MOM_MEKE_types type, public :: MEKE_type ! Variables real, dimension(:,:), pointer :: & - MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [m2 s-2]. - GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [W m-2]. - mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [W m-2]. - GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [W m-2]. - Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [m2 s-1]. - Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse MEKE [m2 s-1]. + MEKE => NULL(), & !< Vertically averaged eddy kinetic energy [L2 T-2 ~> m2 s-2]. + GM_src => NULL(), & !< MEKE source due to thickness mixing (GM) [kg m-2 L2 T-3 ~> W m-2]. + mom_src => NULL(),& !< MEKE source from lateral friction in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + GME_snk => NULL(),& !< MEKE sink from GME backscatter in the momentum equations [kg m-2 L2 T-3 ~> W m-2]. + Kh => NULL(), & !< The MEKE-derived lateral mixing coefficient [L2 T-1 ~> m2 s-1]. + Kh_diff => NULL(), & !< Uses the non-MEKE-derived thickness diffusion coefficient to diffuse + !! MEKE [L2 T-1 ~> m2 s-1]. Rd_dx_h => NULL() !< The deformation radius compared with the grid spacing [nondim]. !! Rd_dx_h is copied from VarMix_CS. - real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient [m2 s-1]. - !! This viscosity can be negative when representing backscatter - !! from unresolved eddies (see Jansen and Held, 2014). - real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity coefficient [m4 s-1]. + real, dimension(:,:), pointer :: Ku => NULL() !< The MEKE-derived lateral viscosity coefficient + !! [L2 T-1 ~> m2 s-1]. This viscosity can be negative when representing + !! backscatter from unresolved eddies (see Jansen and Held, 2014). + real, dimension(:,:), pointer :: Au => NULL() !< The MEKE-derived lateral biharmonic viscosity + !! coefficient [L4 T-1 ~> m4 s-1]. ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index fe9073b7f1..b798fb4d86 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -3,6 +3,7 @@ module MOM_hor_visc ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_checksums, only : hchksum, Bchksum 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, pass_vector, AGRID, BGRID_NE @@ -29,6 +30,7 @@ module MOM_hor_visc type, public :: hor_visc_CS ; private logical :: Laplacian !< Use a Laplacian horizontal viscosity if true. logical :: biharmonic !< Use a biharmonic horizontal viscosity if true. + logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: no_slip !< If true, no slip boundary conditions are used. !! Otherwise free slip boundary conditions are assumed. !! The implementation of the free slip boundary @@ -46,7 +48,7 @@ module MOM_hor_visc !! biharmonic viscosity to guarantee stability. real :: bound_coef !< The nondimensional coefficient of the ratio of !! the viscosity bounds to the theoretical maximum - !! for stability without considering other terms. + !! for stability without considering other terms [nondim]. !! The default is 0.8. logical :: Smagorinsky_Kh !< If true, use Smagorinsky nonlinear eddy !! viscosity. KH is the background value. @@ -66,34 +68,37 @@ module MOM_hor_visc !! scales quadratically with the velocity shears. logical :: use_Kh_bg_2d !< Read 2d background viscosity from a file. real :: Kh_bg_min !< The minimum value allowed for Laplacian horizontal - !! viscosity [m2 s-1]. The default is 0.0 + !! viscosity [L2 T-1 ~> m2 s-1]. The default is 0.0. logical :: use_land_mask !< Use the land mask for the computation of thicknesses !! at velocity locations. This eliminates the dependence on !! arbitrary values over land or outside of the domain. !! Default is False to maintain answers with legacy experiments !! but should be changed to True for new experiments. logical :: anisotropic !< If true, allow anisotropic component to the viscosity. - real :: Kh_aniso !< The anisotropic viscosity [m2 s-1]. + real :: Kh_aniso !< The anisotropic viscosity [L2 T-1 ~> m2 s-1]. logical :: dynamic_aniso !< If true, the anisotropic viscosity is recomputed as a function !! of state. This is set depending on ANISOTROPIC_MODE. logical :: res_scale_MEKE !< If true, the viscosity contribution from MEKE is scaled by !! the resolution function. logical :: use_GME !< If true, use GME backscatter scheme. + 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. real :: GME_h0 !< The strength of GME tapers quadratically to zero when the bathymetric !! depth is shallower than GME_H0 [m] 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 [m2 s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_xx - !< The background Laplacian viscosity at h points [m2 s-1]. + !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Kh_bg_2d - !< The background Laplacian viscosity at h points [m2 s-1]. + !< The background Laplacian viscosity at h points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Ah_bg_xx - !< The background biharmonic viscosity at h points [m4 s-1]. + !< The background biharmonic viscosity at h points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Biharm5_const2_xx @@ -103,19 +108,19 @@ module MOM_hor_visc !! velocity differences reach a value of order 1/2 MAXVEL. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: reduction_xx !< The amount by which stresses through h points are reduced - !! due to partial barriers. Nondimensional. + !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [m2 s-1]. - Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [m4 s-1]. + Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points n1n1_m_n2n2_h !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy - !< The background Laplacian viscosity at q points [m2 s-1]. + !< The background Laplacian viscosity at q points [L2 T-1 ~> m2 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Ah_bg_xy - !< The background biharmonic viscosity at q points [m4 s-1]. + !< The background biharmonic viscosity at q points [L4 T-1 ~> m4 s-1]. !! The actual viscosity may be the larger of this !! viscosity and the Smagorinsky and Leith viscosities. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Biharm5_const2_xy @@ -127,43 +132,43 @@ module MOM_hor_visc !< The amount by which stresses through q points are reduced !! due to partial barriers [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [m2 s-1]. - Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [m4 s-1]. + Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. + Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - dx2h, & !< Pre-calculated dx^2 at h points [m2] - dy2h, & !< Pre-calculated dy^2 at h points [m2] + dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] + dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] dy_dxT !< Pre-calculated dy/dx at h points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - dx2q, & !< Pre-calculated dx^2 at q points [m2] - dy2q, & !< Pre-calculated dy^2 at q points [m2] + dx2q, & !< Pre-calculated dx^2 at q points [L2 ~> m2] + dy2q, & !< Pre-calculated dy^2 at q points [L2 ~> m2] dx_dyBu, & !< Pre-calculated dx/dy at q points [nondim] dy_dxBu !< Pre-calculated dy/dx at q points [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Idx2dyCu, & !< 1/(dx^2 dy) at u points [m-3] - Idxdy2u !< 1/(dx dy^2) at u points [m-3] + Idx2dyCu, & !< 1/(dx^2 dy) at u points [L-3 ~> m-3] + Idxdy2u !< 1/(dx dy^2) at u points [L-3 ~> m-3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Idx2dyCv, & !< 1/(dx^2 dy) at v points [m-3] - Idxdy2v !< 1/(dx dy^2) at v points [m-3] + Idx2dyCv, & !< 1/(dx^2 dy) at v points [L-3 ~> m-3] + Idxdy2v !< 1/(dx dy^2) at v points [L-3 ~> m-3] ! The following variables are precalculated time-invariant combinations of ! parameters and metric terms. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - Laplac2_const_xx, & !< Laplacian metric-dependent constants [nondim] - Biharm5_const_xx, & !< Biharmonic metric-dependent constants [nondim] - Laplac3_const_xx, & !< Laplacian metric-dependent constants [nondim] - Biharm_const_xx, & !< Biharmonic metric-dependent constants [nondim] - Biharm_const2_xx !< Biharmonic metric-dependent constants [nondim] + Laplac2_const_xx, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xx, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xx, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xx, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xx !< Biharmonic metric-dependent constants [T L4 ~> s m4] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & - Laplac2_const_xy, & !< Laplacian metric-dependent constants [nondim] - Biharm5_const_xy, & !< Biharmonic metric-dependent constants [nondim] - Laplac3_const_xy, & !< Laplacian metric-dependent constants [nondim] - Biharm_const_xy, & !< Biharmonic metric-dependent constants [nondim] - Biharm_const2_xy !< Biharmonic metric-dependent constants [nondim] + Laplac2_const_xy, & !< Laplacian metric-dependent constants [L2 ~> m2] + Biharm5_const_xy, & !< Biharmonic metric-dependent constants [L5 ~> m5] + Laplac3_const_xy, & !< Laplacian metric-dependent constants [L3 ~> m3] + Biharm_const_xy, & !< Biharmonic metric-dependent constants [L4 ~> m4] + Biharm_const2_xy !< Biharmonic metric-dependent constants [T L4 ~> s m4] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics @@ -175,8 +180,7 @@ module MOM_hor_visc integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 - integer :: id_FrictWorkMax = -1 - integer :: id_FrictWork_diss = -1, id_FrictWork_GME = -1 + integer :: id_FrictWork_GME = -1 !!@} @@ -201,17 +205,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(out) :: diffu !< Zonal acceleration due to convergence of - !! along-coordinate stress tensor [m s-2] + !! along-coordinate stress tensor [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & intent(out) :: diffv !< Meridional acceleration due to convergence - !! of along-coordinate stress tensor [m s-2]. + !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields !! related to Mesoscale Eddy Kinetic Energy. type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that @@ -225,17 +229,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - u0, & ! Laplacian of u [m-1 s-1] + Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. - vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] - div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] - ubtav ! zonal barotropic vel. ave. over baroclinic time-step [m s-1] + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [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 vel. ave. over baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - v0, & ! Laplacian of v [m-1 s-1] + Del2v, & ! The v-compontent 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)) [m-1 s-1] - div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] - vbtav ! meridional barotropic vel. ave. over baroclinic time-step [m s-1] + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [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 vel. ave. over 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 [s-1] div_xx, & ! Estimate of horizontal divergence at h-points [s-1] @@ -258,8 +262,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [s-1] - dvdx3, dudy3, & ! components in the shearing strain on the Laplacian [m-2 s-1] - dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [s-1] + dDel2vdx, dDel2udy, & ! Components in the biharmonic equivalent of the shearing strain [L-2 T-1 ~> m-2 s-1] + dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [s-1] str_xy, & ! str_xy is the cross term in the stress tensor [H m2 s-2 ~> m3 s-2 or kg s-2] @@ -296,24 +300,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, target_diss_rate_GME, & ! the maximum theoretical dissipation plus the amount spuriously dissipated ! by friction [m2 s-3] FrictWork, & ! work done by MKE dissipation mechanisms [W m-2] - FrictWork_diss, & ! negative definite work done by MKE dissipation mechanisms [W m-2] - FrictWorkMax, & ! maximum possible work done by MKE dissipation mechanisms [W m-2] FrictWork_GME, & ! work done by GME [W m-2] div_xx_h ! horizontal divergence [s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - KH_t_GME, & !< interface height diffusivities in t-columns [m2 s-1] - GME_coeff_h !< GME coeff. at h-points [m2 s-1] - real :: Ah ! biharmonic viscosity [m4 s-1] - real :: Kh ! Laplacian viscosity [m2 s-1] - real :: AhSm ! Smagorinsky biharmonic viscosity [m4 s-1] - real :: KhSm ! Smagorinsky Laplacian viscosity [m2 s-1] - real :: AhLth ! 2D Leith biharmonic viscosity [m4 s-1] - real :: KhLth ! 2D Leith Laplacian viscosity [m2 s-1] + GME_coeff_h !< GME coeff. at h-points [L2 T-1 ~> m2 s-1] + real :: Ah ! biharmonic viscosity [L4 T-1 ~> m4 s-1] + real :: Kh ! Laplacian viscosity [L2 T-1 ~> m2 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 :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith ! viscosity. Here set equal to nondimensional Laplacian Leith constant. ! This is set equal to zero if modified Leith is not used. - real :: Shear_mag ! magnitude of the shear [s-1] - real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [m-1 s-1] + real :: Shear_mag ! magnitude of the shear [T-1 ~> s-1] + real :: vert_vort_mag ! magnitude of the vertical vorticity gradient [L-1 T-1 ~> m-1 s-1] real :: h2uq, h2vq ! temporary variables [H2 ~> m2 or kg2 m-4]. real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity @@ -328,14 +327,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: Kh_scale ! A factor between 0 and 1 by which the horizontal ! Laplacian viscosity is rescaled [nondim] real :: RoScl ! The scaling function for MEKE source term [nondim] - real :: FatH ! abs(f) at h-point for MEKE source term [s-1] - real :: local_strain ! Local variable for interpolating computed strain rates [s-1]. + real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] + real :: local_strain ! Local variable for interpolating computed strain rates [T-1 ~> s-1]. real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. - real :: GME_coeff ! The GME (negative) viscosity coefficient [m2 s-1] - real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [m2 s-1] - real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient - real :: DY_dxBu, DX_dyBu - real :: H0 ! Depth used to scale down GME coefficient in shallow areas [m] + real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] + real :: GME_coeff_limiter ! Maximum permitted value of the GME coefficient [L2 T-1 ~> m2 s-1] + real :: FWfrac ! Fraction of maximum theoretical energy transfer to use when scaling GME coefficient [nondim] + real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] + real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] + real :: Sh_F_pow ! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim] + real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter + ! calculation gives the same value as if f were 0 [nondim]. + real :: H0_GME ! Depth used to scale down GME coefficient in shallow areas [Z ~> m] logical :: rescale_Kh, legacy_bound logical :: find_FrictWork logical :: apply_OBC = .false. @@ -366,9 +369,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (.not.(CS%Laplacian .or. CS%biharmonic)) return find_FrictWork = (CS%id_FrictWork > 0) - if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. + if (CS%id_FrictWorkIntz > 0) find_FrictWork = .true. if (associated(MEKE)) then if (associated(MEKE%mom_src)) find_FrictWork = .true. + backscat_subround = 0.0 + if (find_FrictWork .and. associated(MEKE%mom_src) .and. (MEKE%backscatter_Ro_c > 0.0) .and. & + (MEKE%backscatter_Ro_Pow /= 0.0)) & + backscat_subround = (1.0e-16/MEKE%backscatter_Ro_c)**(1.0/MEKE%backscatter_Ro_Pow) endif rescale_Kh = .false. @@ -386,15 +393,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, use_MEKE_Ku = associated(MEKE%Ku) use_MEKE_Au = associated(MEKE%Au) - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - boundary_mask_h(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) - enddo ; enddo + if (CS%use_GME) then + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 + boundary_mask_h(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) + enddo ; enddo - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - boundary_mask_q(I,J) = (G%mask2dCv(i,J) * G%mask2dCv(i+1,J) * G%mask2dCu(I,j) * G%mask2dCu(I,j-1)) - enddo; enddo + do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + boundary_mask_q(I,J) = (G%mask2dCv(i,J) * G%mask2dCv(i+1,J) * G%mask2dCu(I,j) * G%mask2dCu(I,j-1)) + enddo; enddo - if (CS%use_GME) then ! initialize diag. array with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 @@ -402,7 +409,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, str_xy_GME(:,:) = 0.0 ! Get barotropic velocities and their gradients - call barotropic_get_tav(BT, ubtav, vbtav, G) + call barotropic_get_tav(BT, ubtav, vbtav, G, US) call pass_vector(ubtav, vbtav, G%Domain) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -414,7 +421,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call pass_vector(dudx_bt, dvdy_bt, G%Domain, stagger=BGRID_NE) - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) enddo ; enddo @@ -453,19 +459,19 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! use_GME - !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,u,v,is,js,ie,je,h, & - !$OMP rescale_Kh,VarMix,h_neglect,h_neglect3, & - !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,apply_OBC,OBC,diffv, & + !$OMP parallel do default(none) shared(Isq,Ieq,Jsq,Jeq,nz,CS,G,GV,US,u,v,is,js,ie,je, & + !$OMP h,rescale_Kh,VarMix,h_neglect,h_neglect3, & + !$OMP Kh_h,Ah_h,Kh_q,Ah_q,diffu,diffv,apply_OBC,OBC, & !$OMP find_FrictWork,FrictWork,use_MEKE_Ku, & !$OMP use_MEKE_Au, MEKE, hq, & !$OMP mod_Leith, legacy_bound, div_xx_h, vort_xy_q) & - !$OMP private(u0, v0, sh_xx, str_xx, visc_bound_rem, & - !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & - !$OMP sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & - !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & - !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & + !$OMP private(Del2u, Del2v, sh_xx, str_xx, visc_bound_rem, & + !$OMP sh_xy,str_xy,Ah,Kh,AhSm,dvdx,dudy,dDel2udy, & + !$OMP dDel2vdx,sh_xx_bt, sh_xy_bt, dvdx_bt, dudy_bt, & + !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv,h_u,h_v, & + !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth, & !$OMP div_xx, div_xx_dx, div_xx_dy, local_strain, & - !$OMP meke_res_fn, & + !$OMP meke_res_fn,Sh_F_pow, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -522,9 +528,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dudy(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - u(I,j,k))*G%IdxCu(I,j) else - dudy(I,J) = 2.0*CS%DX_dyBu(I,J)*(u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) + dudy(I,J) = 2.0*CS%DX_dyBu(I,J)* & + (u(I,j+1,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdxCu(I,j+1) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_N) then @@ -542,9 +550,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx(I,J) = 0. elseif (OBC%computed_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (OBC%segment(n)%tangential_vel(I,J,k) - v(i,J,k))*G%IdyCv(i,J) else - dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)*(v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) + dvdx(I,J) = 2.0*CS%DY_dxBu(I,J)* & + (v(i+1,J,k) - OBC%segment(n)%tangential_vel(I,J,k))*G%IdyCv(i+1,J) endif elseif (OBC%specified_strain) then if (OBC%segment(n)%direction == OBC_DIRECTION_E) then @@ -630,26 +640,26 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif - ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) + ! Evaluate Del2u = x.Div(Grad u) and Del2v = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 - u0(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*sh_xx(i+1,j) - CS%DY2h(i,j)*sh_xx(i,j)) + & - CS%IDX2dyCu(I,j)*(CS%DX2q(I,J)*sh_xy(I,J) - CS%DX2q(I,J-1)*sh_xy(I,J-1)) + Del2u(I,j) = CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*sh_xx(i+1,j) - CS%dy2h(i,j)*sh_xx(i,j)) + & + CS%Idx2dyCu(I,j)*(CS%dx2q(I,J)*sh_xy(I,J) - CS%dx2q(I,J-1)*sh_xy(I,J-1)) enddo ; enddo do J=Jsq-1,Jeq+1 ; do i=is-1,Ieq+1 - v0(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J)*sh_xy(I,J) - CS%DY2q(I-1,J)*sh_xy(I-1,J)) - & - CS%IDX2dyCv(i,J)*(CS%DX2h(i,j+1)*sh_xx(i,j+1) - CS%DX2h(i,j)*sh_xx(i,j)) + Del2v(i,J) = CS%Idxdy2v(i,J)*(CS%dy2q(I,J)*sh_xy(I,J) - CS%dy2q(I-1,J)*sh_xy(I-1,J)) - & + CS%Idx2dyCv(i,J)*(CS%dx2h(i,j+1)*sh_xx(i,j+1) - CS%dx2h(i,j)*sh_xx(i,j)) enddo ; enddo if (apply_OBC) then; if (OBC%zero_biharmonic) then do n=1,OBC%number_of_segments I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= Jsq-1) .and. (J <= Jeq+1)) then do I=OBC%segment(n)%HI%isd,OBC%segment(n)%HI%ied - v0(i,J) = 0. + Del2v(i,J) = 0. enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= Isq-1) .and. (I <= Ieq+1)) then do j=OBC%segment(n)%HI%jsd,OBC%segment(n)%HI%jed - u0(I,j) = 0. + Del2u(I,j) = 0. enddo endif enddo @@ -690,7 +700,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & - G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j) / & (h(i,j,k) + GV%H_subroundoff) enddo ; enddo @@ -731,45 +741,45 @@ 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 - vort_xy_dx(i,J) = vort_xy_dx(i,J) + 0.5 * ( G%dF_dx(i,j) + G%dF_dx(i,j+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 - vort_xy_dy(I,j) = vort_xy_dy(I,j) + 0.5 * ( G%dF_dy(i,j) + G%dF_dy(i+1,j)) + 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-1,Jeq+2 ; do i=Isq-1,Ieq+2 - 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 - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I,j+1)))**2 ) + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + 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 + do J=js-1,Jeq ; do I=is-1,Ieq + grad_vort_mag_q_2d(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo - call calc_QG_Leith_viscosity(VarMix, G, GV, h, k, div_xx_dx, div_xx_dy, & + ! This accumulates terms, some of which are in VarMix, so rescaling can not be done here. + call calc_QG_Leith_viscosity(VarMix, G, GV, US, h, k, div_xx_dx, div_xx_dy, & vort_xy_dx, vort_xy_dy) endif - do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - 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 - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + (0.5*(vort_xy_dy(I,j) + & - vort_xy_dy(I,j+1)))**2 ) + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + 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 + do J=js-1,Jeq ; do I=is-1,Ieq + grad_vort_mag_q(I,J) = SQRT((0.5*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J)))**2 + & + (0.5*(vort_xy_dy(I,j) + vort_xy_dy(I,j+1)))**2 ) enddo ; enddo endif ! CS%Leith_Kh meke_res_fn = 1. - do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((CS%Smagorinsky_Kh) .or. (CS%Smagorinsky_Ah)) then Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & @@ -777,9 +787,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3*grad_vort_mag_h_2d(i,j)) + vert_vort_mag = MIN(grad_vort_mag_h(i,j) + grad_div_mag_h(i,j),3.*grad_vort_mag_h_2d(i,j)) else - vert_vort_mag = grad_vort_mag_h(i,j) + grad_div_mag_h(i,j) + vert_vort_mag = (grad_vort_mag_h(i,j) + grad_div_mag_h(i,j)) endif endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then @@ -800,7 +810,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Older method of bounding for stability if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xx(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. - if (use_MEKE_Ku) Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) + if (use_MEKE_Ku) & + Kh = Kh + MEKE%Ku(i,j) * meke_res_fn ! *Add* the MEKE contribution (might be negative) if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * ( 1. - CS%n1n2_h(i,j)**2 ) ! *Add* the tension component ! of anisotropic viscosity @@ -814,8 +825,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if ((CS%id_Kh_h>0) .or. find_FrictWork) Kh_h(i,j,k) = Kh + if ((CS%id_Kh_h>0) .or. find_FrictWork .or. CS%debug) Kh_h(i,j,k) = Kh if (CS%id_div_xx_h>0) div_xx_h(i,j,k) = div_xx(i,j) +! if (CS%debug) sh_xx_3d(i,j,k) = sh_xx(i,j) str_xx(i,j) = -Kh * sh_xx(i,j) else ! not Laplacian @@ -836,14 +848,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((CS%Smagorinsky_Ah) .or. (CS%Leith_Ah)) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%Biharm_const_xx(i,j) + & - CS%Biharm_const2_xx(i,j)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm_const_xx(i,j) + & + CS%Biharm_const2_xx(i,j)*Shear_mag) else AhSm = CS%Biharm_const_xx(i,j) * Shear_mag endif endif - if (CS%Leith_Ah) AhLth = CS%biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 - Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm),AhLth) + if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xx(i,j) * vert_vort_mag * inv_PI5 + Ah = MAX(MAX(CS%Ah_bg_xx(i,j), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xx(i,j)) else @@ -856,16 +868,16 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xx(i,j)) endif - if ((CS%id_Ah_h>0) .or. find_FrictWork) Ah_h(i,j,k) = Ah + if ((CS%id_Ah_h>0) .or. find_FrictWork .or. CS%debug) Ah_h(i,j,k) = Ah str_xx(i,j) = str_xx(i,j) + Ah * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xx(i,j) = Ah * & - (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0(I,j) - G%IdyCu(I-1,j)*u0(I-1,j)) - & - CS%DX_dyT(i,j) *(G%IdxCv(i,J)*v0(i,J) - G%IdxCv(i,J-1)*v0(i,J-1))) + bhstr_xx(i,j) = Ah * & + (CS%DY_dxT(i,j) * (G%IdyCu(I,j)*Del2u(I,j) - G%IdyCu(I-1,j)*Del2u(I-1,j)) - & + CS%DX_dyT(i,j) * (G%IdxCv(i,J)*Del2v(i,J) - G%IdxCv(i,J-1)*Del2v(i,J-1))) bhstr_xx(i,j) = bhstr_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) endif ! biharmonic @@ -875,8 +887,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%biharmonic) then ! Gradient of Laplacian, for use in bi-harmonic term do J=js-1,Jeq ; do I=is-1,Ieq - dvdx3(I,J) = CS%DY_dxBu(I,J)*(v0(i+1,J)*G%IdyCv(i+1,J) - v0(i,J)*G%IdyCv(i,J)) - dudy3(I,J) = CS%DX_dyBu(I,J)*(u0(I,j+1)*G%IdxCu(I,j+1) - u0(I,j)*G%IdxCu(I,j)) + dDel2vdx(I,J) = CS%DY_dxBu(I,J)*(Del2v(i+1,J)*G%IdyCv(i+1,J) - Del2v(i,J)*G%IdyCv(i,J)) + dDel2udy(I,J) = CS%DX_dyBu(I,J)*(Del2u(I,j+1)*G%IdxCu(I,j+1) - Del2u(I,j)*G%IdxCu(I,j)) enddo ; enddo ! Adjust contributions to shearing strain on open boundaries. if (apply_OBC) then ; if (OBC%zero_strain .or. OBC%freeslip_strain) then @@ -885,17 +897,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= Jeq)) then do I=OBC%segment(n)%HI%IsdB,OBC%segment(n)%HI%IedB if (OBC%zero_strain) then - dvdx3(I,J) = 0. ; dudy3(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - dudy3(I,J) = 0. + dDel2udy(I,J) = 0. endif enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= Ieq)) then do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB if (OBC%zero_strain) then - dvdx3(I,J) = 0. ; dudy3(I,J) = 0. + dDel2vdx(I,J) = 0. ; dDel2udy(I,J) = 0. elseif (OBC%freeslip_strain) then - dvdx3(I,J) = 0. + dDel2vdx(I,J) = 0. endif enddo endif @@ -913,9 +925,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then if (CS%use_QG_Leith_visc) then - vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3*grad_vort_mag_q_2d(I,J)) + vert_vort_mag = MIN(grad_vort_mag_q(I,J) + grad_div_mag_q(I,J), 3.*grad_vort_mag_q_2d(I,J)) else - vert_vort_mag = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) + vert_vort_mag = (grad_vort_mag_q(I,J) + grad_div_mag_q(I,J)) endif endif h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) @@ -962,8 +974,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (legacy_bound) Kh = min(Kh, CS%Kh_Max_xy(i,j)) Kh = max( Kh, CS%Kh_bg_min ) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative) - Kh = Kh + 0.25*( (MEKE%Ku(I,J)+MEKE%Ku(I+1,J+1)) & - +(MEKE%Ku(I+1,J)+MEKE%Ku(I,J+1)) ) * meke_res_fn + Kh = Kh + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + (MEKE%Ku(i+1,j) + MEKE%Ku(i,j+1)) ) * meke_res_fn endif ! Older method of bounding for stability if (CS%anisotropic) Kh = Kh + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! *Add* the shear component @@ -979,8 +991,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif endif - if (CS%id_Kh_q>0) Kh_q(I,J,k) = Kh + if (CS%id_Kh_q>0 .or. CS%debug) Kh_q(I,J,k) = Kh if (CS%id_vort_xy_q>0) vort_xy_q(I,J,k) = vort_xy(I,J) +! if (CS%debug) sh_xy_3d(I,J,k) = sh_xy(I,J) str_xy(I,J) = -Kh * sh_xy(I,J) else ! not Laplacian @@ -1001,14 +1014,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Ah .or. CS%Leith_Ah) then if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then - AhSm = Shear_mag * (CS%Biharm_const_xy(I,J) + & - CS%Biharm_const2_xy(I,J)*Shear_mag) + AhSm = Shear_mag * (CS%Biharm_const_xy(I,J) + & + CS%Biharm_const2_xy(I,J)*Shear_mag) else AhSm = CS%Biharm_const_xy(I,J) * Shear_mag endif endif if (CS%Leith_Ah) AhLth = CS%Biharm5_const_xy(I,J) * vert_vort_mag * inv_PI5 - Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm),AhLth) + Ah = MAX(MAX(CS%Ah_bg_xy(I,J), AhSm), AhLth) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) & Ah = MIN(Ah, CS%Ah_Max_xy(I,J)) else @@ -1016,49 +1029,44 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! Smagorinsky_Ah or Leith_Ah if (use_MEKE_Au) then ! *Add* the MEKE contribution - Ah = Ah + 0.25*( (MEKE%Au(I,J)+MEKE%Au(I+1,J+1)) & - +(MEKE%Au(I+1,J)+MEKE%Au(I,J+1)) ) + Ah = Ah + 0.25*( (MEKE%Au(I,J) + MEKE%Au(I+1,J+1)) + & + (MEKE%Au(I+1,J) + MEKE%Au(I,J+1)) ) endif if (CS%better_bound_Ah) then Ah = MIN(Ah, visc_bound_rem*hrat_min*CS%Ah_Max_xy(I,J)) endif - if (CS%id_Ah_q>0) Ah_q(I,J,k) = Ah + if (CS%id_Ah_q>0 .or. CS%debug) Ah_q(I,J,k) = Ah - str_xy(I,J) = str_xy(I,J) + Ah * ( dvdx3(I,J) + dudy3(I,J) ) + str_xy(I,J) = str_xy(I,J) + Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) ! Keep a copy of the biharmonic contribution for backscatter parameterization - bhstr_xy(I,J) = Ah * ( dvdx3(I,J) + dudy3(I,J) ) * & + bhstr_xy(I,J) = Ah * ( dDel2vdx(I,J) + dDel2udy(I,J) ) * & (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) endif ! biharmonic enddo ; enddo + if (CS%use_GME) then - if (CS%use_GME) then - - do j = js, je ; do i = is, ie - grad_vel_mag_h(i,j) = boundary_mask_h(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*((dvdx(I,J)+dvdx(I-1,J-1))+(dvdx(I,J-1)+dvdx(I-1,J))))**2 + & - (0.25*((dudy(I,J)+dudy(I-1,J-1))+(dudy(I,J-1)+dudy(I-1,J))))**2) - - max_diss_rate_h(i,j,k) = 2.0 * MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) - enddo ; enddo - - do J = G%JscB, G%JecB ; do I = G%IscB, G%IecB - grad_vel_mag_q(I,J) = boundary_mask_q(I,J) * (dudx(i,j)**2 + dvdy(i,j)**2 + & - (0.25*((dvdx(I,J)+dvdx(I-1,J-1))+(dvdx(I,J-1)+dvdx(I-1,J))))**2 + & - (0.25*((dudy(I,J)+dudy(I-1,J-1))+(dudy(I,J-1)+dudy(I-1,J))))**2) + do j = js, je ; do i = is, ie + grad_vel_mag_h(i,j) = boundary_mask_h(i,j) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*((dvdx(I,J)+dvdx(I-1,J-1))+(dvdx(I,J-1)+dvdx(I-1,J))))**2 + & + (0.25*((dudy(I,J)+dudy(I-1,J-1))+(dudy(I,J-1)+dudy(I-1,J))))**2) + max_diss_rate_h(i,j,k) = 2.0 * MEKE%MEKE(i,j) * sqrt(grad_vel_mag_h(i,j)) + enddo ; enddo - max_diss_rate_q(I,J,k) = 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)+ & - MEKE%MEKE(i,j+1)+MEKE%MEKE(i+1,j+1)) * sqrt(grad_vel_mag_q(I,J)) - enddo ; enddo - endif + do J = G%JscB, G%JecB ; do I = G%IscB, G%IecB + grad_vel_mag_q(I,J) = boundary_mask_q(I,J) * (dudx(i,j)**2 + dvdy(i,j)**2 + & + (0.25*((dvdx(I,J)+dvdx(I-1,J-1))+(dvdx(I,J-1)+dvdx(I-1,J))))**2 + & + (0.25*((dudy(I,J)+dudy(I-1,J-1))+(dudy(I,J-1)+dudy(I-1,J))))**2) - if (CS%use_GME) then + max_diss_rate_q(I,J,k) = 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)+ & + MEKE%MEKE(i,j+1)+MEKE%MEKE(i+1,j+1)) * sqrt(grad_vel_mag_q(I,J)) + enddo ; enddo do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 if ((grad_vel_mag_bt_h(i,j)>0) .and. (max_diss_rate_h(i,j,k)>0)) then @@ -1077,7 +1085,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq if ((grad_vel_mag_bt_q(I,J)>0) .and. (max_diss_rate_q(I,J,k)>0)) then @@ -1096,7 +1103,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo - ! applying GME diagonal term + ! Applying GME diagonal term. This is linear and the arguments can be rescaled. call smooth_GME(CS,G,GME_flux_h=str_xx_GME) call smooth_GME(CS,G,GME_flux_q=str_xy_GME) @@ -1134,14 +1141,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif ! use_GME - - ! Evaluate 1/h x.Div(h Grad u) or the biharmonic equivalent. do j=js,je ; do I=Isq,Ieq - diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%DY2h(i,j) *str_xx(i,j) - & - CS%DY2h(i+1,j)*str_xx(i+1,j)) + & - G%IdxCu(I,j)*(CS%DX2q(I,J-1)*str_xy(I,J-1) - & - CS%DX2q(I,J) *str_xy(I,J))) * & + diffu(I,j,k) = ((G%IdyCu(I,j)*(CS%dy2h(i,j) *str_xx(i,j) - & + CS%dy2h(i+1,j)*str_xx(i+1,j)) + & + G%IdxCu(I,j)*(CS%dx2q(I,J-1)*str_xy(I,J-1) - & + CS%dx2q(I,J) *str_xy(I,J))) * & G%IareaCu(I,j)) / (h_u(i,j) + h_neglect) enddo ; enddo @@ -1160,10 +1165,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Evaluate 1/h y.Div(h Grad u) or the biharmonic equivalent. do J=Jsq,Jeq ; do i=is,ie - diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%DY2q(I-1,J)*str_xy(I-1,J) - & - CS%DY2q(I,J) *str_xy(I,J)) - & - G%IdxCv(i,J)*(CS%DX2h(i,j) *str_xx(i,j) - & - CS%DX2h(i,j+1)*str_xx(i,j+1))) * & + diffv(i,J,k) = ((G%IdyCv(i,J)*(CS%dy2q(I-1,J)*str_xy(I-1,J) - & + CS%dy2q(I,J) *str_xy(I,J)) - & + G%IdxCv(i,J)*(CS%dx2h(i,j) *str_xx(i,j) - & + CS%dx2h(i,j+1)*str_xx(i,j+1))) * & G%IareaCv(i,J)) / (h_v(i,J) + h_neglect) enddo ; enddo if (apply_OBC) then @@ -1215,19 +1220,29 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (MEKE%backscatter_Ro_c /= 0.) then do j=js,je ; do i=is,ie - FatH = 0.25*US%s_to_T*( (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1))) ) + FatH = 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))) ) Shear_mag = sqrt(sh_xx(i,j)*sh_xx(i,j) + & 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) - FatH = FatH ** MEKE%backscatter_Ro_pow ! f^n - !### Note the hard-coded dimensional constant in the following line. - Shear_mag = ( ( Shear_mag ** MEKE%backscatter_Ro_pow ) + 1.e-30 ) & - * MEKE%backscatter_Ro_c ! c * D^n - ! The Rossby number function is g(Ro) = 1/(1+c.Ro^n) - ! RoScl = 1 - g(Ro) - RoScl = Shear_mag / ( FatH + Shear_mag ) ! = 1 - f^n/(f^n+c*D^n) - MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & + if (CS%answers_2018) then + FatH = (US%s_to_T*FatH)**MEKE%backscatter_Ro_pow ! f^n + ! Note the hard-coded dimensional constant in the following line that can not + ! be rescaled for dimensional consistency. + Shear_mag = ( ( (US%s_to_T*Shear_mag)**MEKE%backscatter_Ro_pow ) + 1.e-30 ) & + * MEKE%backscatter_Ro_c ! c * D^n + ! The Rossby number function is g(Ro) = 1/(1+c.Ro^n) + ! RoScl = 1 - g(Ro) + RoScl = Shear_mag / ( FatH + Shear_mag ) ! = 1 - f^n/(f^n+c*D^n) + else + if (FatH <= backscat_subround*Shear_mag) then + RoScl = 1.0 + else + Sh_F_pow = MEKE%backscatter_Ro_c * (Shear_mag / FatH)**MEKE%backscatter_Ro_pow + RoScl = Sh_F_pow / (1.0 + Sh_F_pow) ! = 1 - f^n/(f^n+c*D^n) + endif + endif + MEKE%mom_src(i,j) = MEKE%mom_src(i,j) + GV%H_to_kg_m2 * ( & ((str_xx(i,j)-RoScl*bhstr_xx(i,j))*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & -(str_xx(i,j)-RoScl*bhstr_xx(i,j))*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & +0.25*(((str_xy(I,J)-RoScl*bhstr_xy(I,J))*( & @@ -1265,8 +1280,6 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_diffu>0) call post_data(CS%id_diffu, diffu, CS%diag) if (CS%id_diffv>0) call post_data(CS%id_diffv, diffv, CS%diag) if (CS%id_FrictWork>0) call post_data(CS%id_FrictWork, FrictWork, CS%diag) - if (CS%id_FrictWorkMax>0) call post_data(CS%id_FrictWorkMax, FrictWorkMax, CS%diag) - if (CS%id_FrictWork_diss>0) call post_data(CS%id_FrictWork_diss, FrictWork_diss, CS%diag) if (CS%id_FrictWork_GME>0) call post_data(CS%id_FrictWork_GME, FrictWork_GME, CS%diag) if (CS%id_Ah_h>0) call post_data(CS%id_Ah_h, Ah_h, CS%diag) if (CS%id_div_xx_h>0) call post_data(CS%id_div_xx_h, div_xx_h, CS%diag) @@ -1277,6 +1290,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%id_GME_coeff_h > 0) call post_data(CS%id_GME_coeff_h, GME_coeff_h, CS%diag) if (CS%id_GME_coeff_q > 0) call post_data(CS%id_GME_coeff_q, GME_coeff_q, CS%diag) + if (CS%debug) then + if (CS%Laplacian) then + call hchksum(Kh_h, "Kh_h", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(Kh_q, "Kh_q", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) +! call Bchksum(sh_xy_3d, "shear_xy", G%HI, haloshift=0, scale=US%s_to_T) +! call hchksum(sh_xx_3d, "shear_xx", G%HI, haloshift=0, scale=US%s_to_T) + endif + if (CS%biharmonic) call hchksum(Ah_h, "Ah_h", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + if (CS%biharmonic) call Bchksum(Ah_q, "Ah_q", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + endif + if (CS%id_FrictWorkIntz > 0) then do j=js,je do i=is,ie ; FrictWorkIntz(i,j) = FrictWork(i,j,1) ; enddo @@ -1292,7 +1316,7 @@ end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). !! hor_visc_init calculates and stores the values of a number of metric functions that !! are used in horizontal_viscosity(). -subroutine hor_visc_init(Time, G, US, param_file, diag, CS) +subroutine hor_visc_init(Time, G, US, param_file, diag, CS, MEKE) type(time_type), intent(in) :: Time !< Current model time. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1300,39 +1324,41 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. type(hor_visc_CS), pointer :: CS !< Pointer to the control structure for this module + type(MEKE_type), pointer :: MEKE !< MEKE data ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! u0v is the Laplacian sensitivities to the v velocities - ! at u points [m-2], with u0u, v0u, and v0v defined similarly. - real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [m2] - real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [m3] - real :: grid_sp_q2 ! spacings at h and q points [m2] - real :: grid_sp_q3 ! spacings at h and q points^(3/2) [m3] - real :: Kh_Limit ! A coefficient [s-1] used, along with the + ! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly. + real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [L2 ~> m2] + real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] + real :: grid_sp_q2 ! spacings at h and q points [L2 ~> m2] + real :: grid_sp_q3 ! spacings at h and q points^(3/2) [L3 ~> m3] + real :: Kh_Limit ! A coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit Laplacian viscosity. real :: fmax ! maximum absolute value of f at the four - ! vorticity points around a thickness point [s-1] - real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations [s2 m-2] - real :: Ah_Limit ! coefficient [s-1] used, along with the + ! vorticity points around a thickness point [T-1 ~> s-1] + real :: BoundCorConst ! A constant used when using viscosity to bound the Coriolis accelerations + ! [T2 L-2 ~> s2 m-2] + real :: Ah_Limit ! coefficient [T-1 ~> s-1] used, along with the ! grid spacing, to limit biharmonic viscosity - real :: Kh ! Lapacian horizontal viscosity [m2 s-1] - real :: Ah ! biharmonic horizontal viscosity [m4 s-1] - real :: Kh_vel_scale ! this speed [m s-1] times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed [m s-1] times grid spacing cubed gives bih visc - real :: Ah_time_scale ! damping time-scale for biharmonic visc + real :: Kh ! Lapacian horizontal viscosity [L2 s-1] + real :: Ah ! biharmonic horizontal viscosity [L4 s-1] + real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc + real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc + real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant real :: Leith_Lap_const ! nondimensional Laplacian Leith constant real :: Leith_bi_const ! nondimensional biharmonic Leith constant - real :: dt ! dynamics time step [s] - real :: Idt ! inverse of dt [s-1] + real :: dt ! The dynamics time step [T ~> s] + real :: Idt ! The inverse of dt [T-1 ~> s-1] real :: denom ! work variable; the denominator of a fraction real :: maxvel ! largest permitted velocity components [m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity - ! balances Coriolis acceleration [m s-1] - real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [m2 s-1] + ! balances Coriolis acceleration [L T-1 ~> m s-1] + real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: get_all ! If true, read and log all parameters, regardless of @@ -1342,6 +1368,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! If false and USE_GME = True, issue a FATAL error. logical :: use_MEKE ! If true, use the MEKE module for calculating eddy kinetic energy. ! If false and USE_GME = True, issue a FATAL error. + logical :: default_2018_answers character(len=64) :: inputdir, filename real :: deg2rad ! Converts degrees to radians @@ -1389,26 +1416,36 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! parameter spelling checks. call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.false.) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "HOR_VISC_2018_ANSWERS", CS%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) + + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) if (CS%Laplacian .or. get_all) then call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & "The velocity scale which is multiplied by the grid "//& "spacing to calculate the Laplacian viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "KH_SIN_LAT", Kh_sin_lat, & "The amplitude of a latitudinally-dependent background "//& "viscosity of the form KH_SIN_LAT*(SIN(LAT)**KH_PWR_OF_SINE).", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) if (Kh_sin_lat>0. .or. get_all) & call get_param(param_file, mdl, "KH_PWR_OF_SINE", Kh_pwr_of_sine, & "The power used to raise SIN(LAT) when using a latitudinally "//& @@ -1471,7 +1508,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%anisotropic .or. get_all) then call get_param(param_file, mdl, "KH_ANISO", CS%Kh_aniso, & "The background Laplacian anisotropic horizontal viscosity.", & - units = "m2 s-1", default=0.0) + units = "m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & "Selects the mode for setting the direction of anistropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& @@ -1499,19 +1536,19 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%biharmonic .or. get_all) then call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & - units = "m4 s-1", default=0.0) + units = "m4 s-1", default=0.0, scale=US%m_to_L**4*US%T_to_s) call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & "The velocity scale which is multiplied by the cube of "//& "the grid spacing to calculate the biharmonic viscosity. "//& "The final viscosity is the largest of this scaled "//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & - units="m s-1", default=0.0) + units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "AH_TIME_SCALE", Ah_time_scale, & "A time scale whose inverse is multiplied by the fourth "//& "power of the grid spacing to calculate biharmonic viscosity. "//& "The final viscosity is the largest of all viscosity "//& "formulations in use. 0.0 means that it's not used.", & - units="s", default=0.0) + units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy "//& "viscosity.", default=.false.) @@ -1548,7 +1585,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) "The velocity scale at which BOUND_CORIOLIS_BIHARM causes "//& "the biharmonic drag to have comparable magnitude to the "//& "Coriolis acceleration. The default is set by MAXVEL.", & - units="m s-1", default=maxvel) + units="m s-1", default=maxvel, scale=US%m_s_to_L_T) endif endif @@ -1608,7 +1645,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) 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", & + "depth is shallower than GME_H0.", units="m", scale=US%m_to_Z, & default=1000.0) call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & @@ -1617,13 +1654,13 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & "The absolute maximum value the GME coefficient is allowed to take.", & - units="m2 s-1", default=1.0e7) + units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7) endif if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & call get_param(param_file, mdl, "DT", dt, & - "The (baroclinic) dynamics time step.", units="s", & + "The (baroclinic) dynamics time step.", units="s", scale=US%s_to_T, & fail_if_missing=.true.) if (CS%no_slip .and. CS%biharmonic) & @@ -1694,7 +1731,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & - G%domain, timelevel=1) + G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif @@ -1725,11 +1762,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - 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%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 - 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%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 @@ -1737,32 +1774,32 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%reduction_xx(i,j) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xx(i,j) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I-1,j) > 0.0) .and. (G%dy_Cu(I-1,j) < G%dyCu(I-1,j)) .and. & (G%dy_Cu(I-1,j) < G%dyCu(I-1,j) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / G%dyCu(I-1,j) + CS%reduction_xx(i,j) = G%dy_Cu(I-1,j) / (G%dyCu(I-1,j)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xx(i,j) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i,J-1) > 0.0) .and. (G%dx_Cv(i,J-1) < G%dxCv(i,J-1)) .and. & (G%dx_Cv(i,J-1) < G%dxCv(i,J-1) * CS%reduction_xx(i,j))) & - CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / G%dxCv(i,J-1) + CS%reduction_xx(i,j) = G%dx_Cv(i,J-1) / (G%dxCv(i,J-1)) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq CS%reduction_xy(I,J) = 1.0 if ((G%dy_Cu(I,j) > 0.0) .and. (G%dy_Cu(I,j) < G%dyCu(I,j)) .and. & (G%dy_Cu(I,j) < G%dyCu(I,j) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j) / G%dyCu(I,j) + CS%reduction_xy(I,J) = G%dy_Cu(I,j) / (G%dyCu(I,j)) if ((G%dy_Cu(I,j+1) > 0.0) .and. (G%dy_Cu(I,j+1) < G%dyCu(I,j+1)) .and. & (G%dy_Cu(I,j+1) < G%dyCu(I,j+1) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / G%dyCu(I,j+1) + CS%reduction_xy(I,J) = G%dy_Cu(I,j+1) / (G%dyCu(I,j+1)) if ((G%dx_Cv(i,J) > 0.0) .and. (G%dx_Cv(i,J) < G%dxCv(i,J)) .and. & (G%dx_Cv(i,J) < G%dxCv(i,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i,J) / G%dxCv(i,J) + CS%reduction_xy(I,J) = G%dx_Cv(i,J) / (G%dxCv(i,J)) if ((G%dx_Cv(i+1,J) > 0.0) .and. (G%dx_Cv(i+1,J) < G%dxCv(i+1,J)) .and. & (G%dx_Cv(i+1,J) < G%dxCv(i+1,J) * CS%reduction_xy(I,J))) & - CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / G%dxCv(i+1,J) + CS%reduction_xy(I,J) = G%dx_Cv(i+1,J) / (G%dxCv(i+1,J)) enddo ; enddo if (CS%Laplacian) then @@ -1773,7 +1810,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! Calculate and store the background viscosity at h-points do j=Jsq,Jeq+1 ; do i=Isq,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)) + 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) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xx(i,j) = Smag_Lap_const * grid_sp_h2 if (CS%Leith_Kh) CS%Laplac3_const_xx(i,j) = Leith_Lap_const * grid_sp_h3 @@ -1799,7 +1836,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) ! Calculate and store the background viscosity at q-points do J=js-1,Jeq ; do I=is-1,Ieq ! Static factors in the Smagorinsky and Leith schemes - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J) + CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J) + CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Kh) CS%Laplac2_const_xy(I,J) = Smag_Lap_const * grid_sp_q2 if (CS%Leith_Kh) CS%Laplac3_const_xy(I,J) = Leith_Lap_const * grid_sp_q3 @@ -1807,6 +1844,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%Kh_bg_xy(I,J) = MAX(Kh, Kh_vel_scale * sqrt(grid_sp_q2)) ! Use the larger of the above and values read from a file + !### This expression uses inconsistent staggering if (CS%use_Kh_bg_2d) CS%Kh_bg_xy(I,J) = MAX(CS%Kh_bg_2d(i,j), CS%Kh_bg_xy(I,J)) ! Use the larger of the above and a function of sin(latitude) @@ -1826,12 +1864,12 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,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)) + 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 - 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)) + 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 CS%Ah_bg_xy(:,:) = 0.0 @@ -1841,14 +1879,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) do j=Jsq,Jeq+1 ; do i=Isq,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_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) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xx(i,j) = Smag_bi_const * (grid_sp_h2 * grid_sp_h2) if (CS%bound_Coriolis) then - fmax = US%s_to_T*MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & - abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) + fmax = MAX(abs(G%CoriolisBu(I-1,J-1)), abs(G%CoriolisBu(I,J-1)), & + abs(G%CoriolisBu(I-1,J)), abs(G%CoriolisBu(I,J))) CS%Biharm_const2_xx(i,j) = (grid_sp_h2 * grid_sp_h2 * grid_sp_h2) * & (fmax * BoundCorConst) endif @@ -1857,7 +1895,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) CS%biharm5_const_xx(i,j) = Leith_bi_const * (grid_sp_h3 * grid_sp_h2) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) - if (Ah_time_scale>0.) CS%Ah_bg_xx(i,j) = & + if (Ah_time_scale > 0.) CS%Ah_bg_xx(i,j) = & MAX(CS%Ah_bg_xx(i,j), (grid_sp_h2 * grid_sp_h2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xx(i,j) = Ah_Limit * (grid_sp_h2 * grid_sp_h2) @@ -1865,14 +1903,14 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq - grid_sp_q2 = (2.0*CS%DX2q(I,J)*CS%DY2q(I,J)) / (CS%DX2q(I,J)+CS%DY2q(I,J)) + grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J)+CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) if (CS%Smagorinsky_Ah) then CS%Biharm_const_xy(I,J) = Smag_bi_const * (grid_sp_q2 * grid_sp_q2) if (CS%bound_Coriolis) then CS%Biharm_const2_xy(I,J) = (grid_sp_q2 * grid_sp_q2 * grid_sp_q2) * & - (abs(US%s_to_T*G%CoriolisBu(I,J)) * BoundCorConst) + (abs(G%CoriolisBu(I,J)) * BoundCorConst) endif endif if (CS%Leith_Ah) then @@ -1880,7 +1918,7 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) endif CS%Ah_bg_xy(I,J) = MAX(Ah, Ah_vel_scale * grid_sp_q2 * sqrt(grid_sp_q2)) - if (Ah_time_scale>0.) CS%Ah_bg_xy(i,j) = & + if (Ah_time_scale > 0.) CS%Ah_bg_xy(i,j) = & MAX(CS%Ah_bg_xy(i,j), (grid_sp_q2 * grid_sp_q2) / Ah_time_scale) if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then CS%Ah_Max_xy(I,J) = Ah_Limit * (grid_sp_q2 * grid_sp_q2) @@ -1894,9 +1932,9 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) Idt = 1.0 / dt do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 denom = max( & - (CS%DY2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) * & + (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)) ), & - (CS%DX2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & + (CS%dx2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) * & max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) CS%Kh_Max_xx(i,j) = 0.0 if (denom > 0.0) & @@ -1904,14 +1942,18 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & + (CS%dx2q(I,J) * CS%DX_dyBu(I,J) * (G%IdxCu(I,j+1) + G%IdxCu(I,j)) * & max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & + (CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) * & max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) CS%Kh_Max_xy(I,J) = 0.0 if (denom > 0.0) & CS%Kh_Max_xy(I,J) = CS%bound_coef * 0.25 * Idt / denom enddo ; enddo + if (CS%debug) then + call hchksum(CS%Kh_Max_xx, "Kh_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + call Bchksum(CS%Kh_Max_xx, "Kh_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) + endif endif ! The biharmonic bounds should avoid overshoots when CS%bound_coef < 0.5, but @@ -1919,35 +1961,35 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (CS%biharmonic .and. CS%better_bound_Ah) then Idt = 1.0 / dt do j=js-1,Jeq+1 ; do I=Isq-1,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)) + & - CS%DX2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) - - u0v(I,j) = CS%IDXDY2u(I,j)*(CS%DY2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & - CS%DY2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & - 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)) ) + 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)) + & + CS%dx2q(I,J-1)*CS%DX_dyBu(I,J-1)*(G%IdxCu(I,j) + G%IdxCu(I,j-1)) ) ) + + u0v(I,j) = (CS%Idxdy2u(I,j)*(CS%dy2h(i+1,j)*CS%DX_dyT(i+1,j)*(G%IdxCv(i+1,J) + G%IdxCv(i+1,J-1)) + & + CS%dy2h(i,j) * CS%DX_dyT(i,j) * (G%IdxCv(i,J) + G%IdxCv(i,J-1)) ) + & + 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 - 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)) + & - CS%DX2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) - - v0v(i,J) = CS%IDXDY2v(i,J)*(CS%DY2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & - CS%DY2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & - 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)) ) + 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)) + & + CS%dx2h(i,j) * CS%DY_dxT(i,j) * (G%IdyCu(I,j) + G%IdyCu(I-1,j)) ) ) + + v0v(i,J) = (CS%Idxdy2v(i,J)*(CS%dy2q(I,J) * CS%DY_dxBu(I,J) * (G%IdyCv(i+1,J) + G%IdyCv(i,J)) + & + CS%dy2q(I-1,J)*CS%DY_dxBu(I-1,J)*(G%IdyCv(i,J) + G%IdyCv(i-1,J)) ) + & + 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 denom = max( & - (CS%DY2h(i,j) * & + (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)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0u(i,J) + G%IdxCv(i,J-1)*v0u(i,J-1))) * & max(G%IdyCu(I,j)*G%IareaCu(I,j), G%IdyCu(I-1,j)*G%IareaCu(I-1,j)) ), & - (CS%DX2h(i,j) * & + (CS%dx2h(i,j) * & (CS%DY_dxT(i,j)*(G%IdyCu(I,j)*u0v(I,j) + G%IdyCu(I-1,j)*u0v(I-1,j)) + & CS%DX_dyT(i,j)*(G%IdxCv(i,J)*v0v(i,J) + G%IdxCv(i,J-1)*v0v(i,J-1))) * & max(G%IdxCv(i,J)*G%IareaCv(i,J), G%IdxCv(i,J-1)*G%IareaCv(i,J-1)) ) ) @@ -1958,11 +2000,11 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) do J=js-1,Jeq ; do I=is-1,Ieq denom = max( & - (CS%DX2q(I,J) * & + (CS%dx2q(I,J) * & (CS%DX_dyBu(I,J)*(u0u(I,j+1)*G%IdxCu(I,j+1) + u0u(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0u(i+1,J)*G%IdyCv(i+1,J) + v0u(i,J)*G%IdyCv(i,J))) * & max(G%IdxCu(I,j)*G%IareaCu(I,j), G%IdxCu(I,j+1)*G%IareaCu(I,j+1)) ), & - (CS%DY2q(I,J) * & + (CS%dy2q(I,J) * & (CS%DX_dyBu(I,J)*(u0v(I,j+1)*G%IdxCu(I,j+1) + u0v(I,j)*G%IdxCu(I,j)) + & CS%DY_dxBu(I,J)*(v0v(i+1,J)*G%IdyCv(i+1,J) + v0v(i,J)*G%IdyCv(i,J))) * & max(G%IdyCv(i,J)*G%IareaCv(i,J), G%IdyCv(i+1,J)*G%IareaCv(i+1,J)) ) ) @@ -1970,69 +2012,68 @@ subroutine hor_visc_init(Time, G, US, param_file, diag, CS) if (denom > 0.0) & CS%Ah_Max_xy(I,J) = CS%bound_coef * 0.5 * Idt / denom enddo ; enddo + if (CS%debug) then + call hchksum(CS%Ah_Max_xx, "Ah_Max_xx", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + call Bchksum(CS%Ah_Max_xx, "Ah_Max_xy", G%HI, haloshift=0, scale=US%L_to_m**4*US%s_to_T) + endif endif ! Register fields for output from this module. CS%id_diffu = register_diag_field('ocean_model', 'diffu', diag%axesCuL, Time, & - 'Zonal Acceleration from Horizontal Viscosity', 'm s-2') + 'Zonal Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_diffv = register_diag_field('ocean_model', 'diffv', diag%axesCvL, Time, & - 'Meridional Acceleration from Horizontal Viscosity', 'm s-2') + 'Meridional Acceleration from Horizontal Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%biharmonic) then CS%id_Ah_h = register_diag_field('ocean_model', 'Ahh', diag%axesTL, Time, & - 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', & + 'Biharmonic Horizontal Viscosity at h Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T, & cmor_field_name='difmxybo', & cmor_long_name='Ocean lateral biharmonic viscosity', & cmor_standard_name='ocean_momentum_xy_biharmonic_diffusivity') CS%id_Ah_q = register_diag_field('ocean_model', 'Ahq', diag%axesBL, Time, & - 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1') + 'Biharmonic Horizontal Viscosity at q Points', 'm4 s-1', conversion=US%L_to_m**4*US%s_to_T) endif if (CS%Laplacian) then CS%id_Kh_h = register_diag_field('ocean_model', 'Khh', diag%axesTL, Time, & - 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', & + 'Laplacian Horizontal Viscosity at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='difmxylo', & cmor_long_name='Ocean lateral Laplacian viscosity', & cmor_standard_name='ocean_momentum_xy_laplacian_diffusivity') CS%id_Kh_q = register_diag_field('ocean_model', 'Khq', diag%axesBL, Time, & - 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1') + 'Laplacian Horizontal Viscosity at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) if (CS%Leith_Kh) then CS%id_vort_xy_q = register_diag_field('ocean_model', 'vort_xy_q', diag%axesBL, Time, & - 'Vertical vorticity at q Points', 's-1') + 'Vertical vorticity at q Points', 's-1', conversion=US%s_to_T) CS%id_div_xx_h = register_diag_field('ocean_model', 'div_xx_h', diag%axesTL, Time, & - 'Horizontal divergence at h Points', 's-1') + 'Horizontal divergence at h Points', 's-1', conversion=US%s_to_T) endif endif if (CS%use_GME) then CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & - 'GME coefficient at h Points', 'm^2 s-1') + 'GME coefficient at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & - 'GME coefficient at q Points', 'm^2 s-1') + 'GME coefficient at q Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_FrictWork_GME = register_diag_field('ocean_model','FrictWork_GME',diag%axesTL,Time,& - 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', 'W m-2') + 'Integral work done by lateral friction terms in GME (excluding diffusion of energy)', & + 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& - 'Integral work done by lateral friction terms', 'W m-2') - - CS%id_FrictWork_diss = register_diag_field('ocean_model','FrictWork_diss',diag%axesTL,Time,& - 'Integral work done by lateral friction terms (excluding diffusion of energy)', 'W m-2') - - CS%id_FrictWorkMax = register_diag_field('ocean_model','FrictWorkMax',diag%axesTL,Time,& - 'Maximum possible integral work done by lateral friction terms', 'W m-2') + 'Integral work done by lateral friction terms', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2) CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & - 'Depth integrated work done by lateral friction', 'W m-2', & + 'Depth integrated work done by lateral friction', 'W m-2', conversion=US%s_to_T**3*US%L_to_m**2, & cmor_field_name='dispkexyfo', & cmor_long_name='Depth integrated ocean kinetic energy dissipation due to lateral friction',& cmor_standard_name='ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction') @@ -2079,7 +2120,6 @@ subroutine smooth_GME(CS,G,GME_flux_h,GME_flux_q) real :: wc, ww, we, wn, ws ! averaging weights for smoothing integer :: i, j, k, s - !do s=1,CS%n_smooth do s=1,1 ! Update halos @@ -2357,7 +2397,7 @@ end subroutine hor_visc_end !! Large et al., 2001, proposed enhancing viscosity in a particular direction and the !! approach was generalized in Smith and McWilliams, 2003. We use the second form of their !! two coefficient anisotropic viscosity (section 4.3). We also replace their -!! \f$A^\prime\f$ nd $D$ such that \f$2A^\prime = 2 \kappa_h + D\f$ and +!! \f$A^\prime\f$ and $D$ such that \f$2A^\prime = 2 \kappa_h + D\f$ and !! \f$\kappa_a = D\f$ so that \f$\kappa_h\f$ can be considered the isotropic !! viscosity and \f$\kappa_a=D\f$ can be consider the anisotropic viscosity. The !! direction of anisotropy is defined by a unit vector \f$\hat{\bf diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index fb35d5b45c..9014cb1dbb 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -65,7 +65,7 @@ module MOM_internal_tides !! is possible (i.e. ridge cells) ! (could be in G control structure) real, allocatable, dimension(:,:,:,:) :: cp - !< horizontal phase speed [m s-1] + !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss !< energy lost due to misc background processes [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_quad_loss @@ -74,7 +74,7 @@ module MOM_internal_tides !< energy lost due to wave breaking [W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed !< fixed part of the energy lost due to small-scale drag - !! [kg Z-2 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] + !! [kg m L-2 Z-1 ~> kg m-2] here; will be multiplied by N and En to get into [W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, @@ -106,7 +106,7 @@ module MOM_internal_tides !< The internal wave energy density as a function of (i,j,angle,frequency,mode) real, dimension(:,:,:), pointer :: En_restart => NULL() !< The internal wave energy density as a function of (i,j,angle); temporary for restart - real, allocatable, dimension(:) :: frequency !< The frequency of each band [s-1]. + real, allocatable, dimension(:) :: frequency !< The frequency of each band [T-1 ~> s-1]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. @@ -166,13 +166,15 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. real, dimension(SZI_(G),SZJ_(G),CS%nMode), & - intent(in) :: cn !< The internal wave speeds of each mode [m s-1]. + intent(in) :: cn !< The internal wave speeds of each + !! mode [L T-1 ~> m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & test real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only - Ub, Umax ! near-bottom & max horizontal velocity of wave (modal) + Ub, & ! near-bottom horizontal velocity of wave (modal) [m s-1] + Umax ! Maximum horizontal velocity of wave (modal) [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & flux_heat_y, & flux_prec_y @@ -183,9 +185,12 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & drag_scale, & ! bottom drag scale, s-1 itidal_loss_mode, allprocesses_loss_mode ! energy loss rates for a given mode and frequency (summed over angles) - real :: frac_per_sector, f2, I_rho0, I_D_here, freq2, Kmag2 - real :: c_phase, loss_rate, Fr2_max - real, parameter :: cn_subRO = 1e-100 ! to prevent division by zero + real :: frac_per_sector, f2, I_rho0, I_D_here, Kmag2 + real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: c_phase ! The phase speed [m s-1] + real :: loss_rate, Fr2_max + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] + real :: dt_in_T ! The timestep [T ~> s] real :: En_new, En_check ! for debugging real :: En_initial, Delta_E_check ! for debugging real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! for debugging @@ -198,6 +203,8 @@ subroutine propagate_int_tide(h, tv, cn, 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 I_rho0 = 1.0 / GV%Rho0 + dt_in_T = US%s_to_T*dt + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. ! 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. @@ -210,8 +217,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%energized_angle <= 0) then frac_per_sector = 1.0 / real(CS%nAngle * CS%nMode * CS%nFreq) 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*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + 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-CS%q_itides)*TKE_itidal_input(i,j) @@ -220,8 +227,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & frac_per_sector = 1.0 / real(CS%nMode * CS%nFreq) 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*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + 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-CS%q_itides)*TKE_itidal_input(i,j) @@ -241,7 +248,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply half the refraction. 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) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%nAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -267,7 +275,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, G, US, CS, CS%NAngle) + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt_in_T, & + G, US, CS, CS%NAngle) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -288,7 +297,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Apply the other half of the refraction. 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) + call refract(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), 0.5*dt_in_T, & + G, US, CS%NAngle, CS%use_PPMang) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -384,8 +394,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Ub(i,j,fr,m) = CS%wave_structure_CSp%Uavg_profile(i,j,nzm) - Umax(i,j,fr,m) = maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) + Ub(i,j,fr,m) = US%m_s_to_L_T * CS%wave_structure_CSp%Uavg_profile(i,j,nzm) + Umax(i,j,fr,m) = US%m_s_to_L_T * maxval(CS%wave_structure_CSp%Uavg_profile(i,j,1:nzm)) enddo ; enddo ! i-loop, j-loop enddo ; enddo ! fr-loop, m-loop endif ! apply_wave or _Froude_drag (Ub or Umax needed) @@ -417,14 +427,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do j=jsd,jed ; do i=isd,ied id_g = i + G%idg_offset ; jd_g = j + G%jdg_offset ! for debugging ! Calculate horizontal phase velocity magnitudes - f2 = 0.25*US%s_to_T**2*((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)) + 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)) Kmag2 = (freq2 - f2) / (cn(i,j,m)**2 + cn_subRO**2) c_phase = 0.0 if (Kmag2 > 0.0) then c_phase = sqrt(freq2/Kmag2) nzm = CS%wave_structure_CSp%num_intfaces(i,j) - Fr2_max = (Umax(i,j,fr,m)/c_phase)**2 + Fr2_max = (Umax(i,j,fr,m) / c_phase)**2 ! Dissipate energy if Fr>1; done here with an arbitrary time scale if (Fr2_max > 1.0) then En_initial = sum(CS%En(i,j,:,fr,m)) ! for debugging @@ -626,9 +636,9 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, intent(in) :: Nb !< Near-bottom stratification [s-1]. 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 [m s-1]. + !! 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 [kg Z-2 ~> kg m-2] + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [kg m L-2 Z-1 ~> kg m-2] !! (rho*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 [J m-2]. @@ -666,7 +676,8 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, enddo ! Calculate TKE loss rate; units of [W m-2] here. - TKE_loss_tot = q_itides * US%Z_to_m**2 * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + TKE_loss_tot = q_itides * US%Z_to_m**3*US%s_to_T**3 * TKE_loss_fixed(i,j) * & + US%T_to_s*Nb(i,j) * Ub(i,j,fr,m)**2 ! 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 @@ -726,7 +737,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss !> Implements refraction on the internal waves at a single frequency. -subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) +subroutine refract(En, cn, freq, dt_in_T, G, US, NAngle, use_PPMang) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -735,9 +746,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather !! than upwind. @@ -753,15 +764,14 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) Flux_E real, dimension(SZI_(G),SZJ_(G),1-stencil:NAngle+stencil) :: & CFL_ang - real :: f2 ! The squared Coriolis parameter [s-2]. - real :: favg ! The average Coriolis parameter at a point [s-1]. - real :: df2_dy, df2_dx ! The x- and y- gradients of the squared Coriolis parameter [s-2 m-1]. - real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [s-1 m-1]. + real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. + real :: favg ! The average Coriolis parameter at a point [T-1 ~> s-1]. + real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [T-1 L-1 ~> s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [m-1]. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [m-1]. real :: Angle_size, dt_Angle_size, angle real :: Ifreq, Kmag2, I_Kmag - real, parameter :: cn_subRO = 1e-100 + real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] integer :: is, ie, js, je, asd, aed, na integer :: i, j, a @@ -769,9 +779,9 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) asd = 1-stencil ; aed = NAngle+stencil Ifreq = 1.0 / freq - + cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. Angle_size = (8.0*atan(1.0)) / (real(NAngle)) - dt_Angle_size = dt / Angle_size + dt_Angle_size = dt_in_T / Angle_size do A=asd,aed angle = (real(A) - 0.5) * Angle_size @@ -792,26 +802,18 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Do the refraction. do i=is,ie - f2 = 0.25*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + 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)) - favg = 0.25*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) - df2_dx = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) - & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdxT(i,j) - df_dx = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & - (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * & - G%IdxT(i,j) + favg = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J))) + df_dx = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1)) - & + (G%CoriolisBu(I-1,J) + G%CoriolisBu(I-1,J-1))) * G%IdxT(i,j) dlnCn_dx = 0.5*( G%IdxCu(I,j) * (cn(i+1,j) - cn(i,j)) / & (0.5*(cn(i+1,j) + cn(i,j)) + cn_subRO) + & G%IdxCu(I-1,j) * (cn(i,j) - cn(i-1,j)) / & (0.5*(cn(i,j) + cn(i-1,j)) + cn_subRO) ) - df2_dy = 0.5*US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) - & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J-1)**2)) * & - G%IdyT(i,j) - df_dy = 0.5*US%s_to_T*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & - (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * & - G%IdyT(i,j) + df_dy = 0.5*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) - & + (G%CoriolisBu(I,J-1) + G%CoriolisBu(I-1,J-1))) * G%IdyT(i,j) dlnCn_dy = 0.5*( G%IdyCv(i,J) * (cn(i,j+1) - cn(i,j)) / & (0.5*(cn(i,j+1) + cn(i,j)) + cn_subRO) + & G%IdyCv(i,J-1) * (cn(i,j) - cn(i,j-1)) / & @@ -829,8 +831,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Determine the energy fluxes in angular orientation space. do A=asd,aed ; do i=is,ie - CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * & - dt_Angle_size + CFL_ang(i,j,A) = (cos_angle(A) * Dl_Dt_Kmag(i) - sin_angle(A) * Dk_Dt_Kmag(i)) * dt_Angle_size if (abs(CFL_ang(i,j,A)) > 1.0) then call MOM_error(WARNING, "refract: CFL exceeds 1.", .true.) if (CFL_ang(i,j,A) > 0.0) then ; CFL_ang(i,j,A) = 1.0 ; else ; CFL_ang(i,j,A) = -1.0 ; endif @@ -850,7 +851,7 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) else ! Use PPM do i=is,ie - call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt,stencil) + call PPM_angular_advect(En2d(i,:),CFL_ang(i,j,:),Flux_E(i,:),NAngle,dt_in_T,stencil) enddo endif @@ -866,10 +867,10 @@ end subroutine refract !> This subroutine calculates the 1-d flux for advection in angular space using a monotonic !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. -subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) +subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt_in_T, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a @@ -887,7 +888,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer :: a real :: aR, aL, dMx, dMn, Ep, Ec, Em, dA, mA, a6 - I_dt = 1 / dt + I_dt = 1 / dt_in_T Angle_size = (8.0*atan(1.0)) / (real(NAngle)) I_Angle_size = 1 / Angle_size Flux_En(:) = 0 @@ -916,7 +917,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aR - 0.5 * CFL_ang(A) * ( ( aR - aL ) - a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux else ! Implementation of PPM-H3 @@ -940,14 +941,14 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) flux = u_ang*( aR + 0.5 * CFL_ang(A) * ( ( aL - aR ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) !flux = u_ang*( aL + 0.5 * CFL_ang(A) * ( ( aR - aL ) + a6 * ( 1. - 2./3. * CFL_ang(A) ) ) ) ! CALCULATE AMOUNT FLUXED (Jm-2) - Flux_En(A) = dt * flux + Flux_En(A) = dt_in_T * flux !Flux_En(A) = (dt * I_Angle_size) * flux endif enddo end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt_in_T, G, US, CS, NAngle) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -956,28 +957,28 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) !! function of space and angular resolution, !! [J m-2 radian-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: cn !< Baroclinic mode speed [m s-1]. - real, intent(in) :: freq !< Wave frequency [s-1]. - real, intent(in) :: dt !< Time step [s]. + intent(in) :: cn !< Baroclinic mode speed [L T-1 ~> m s-1]. + real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. + real, intent(in) :: dt_in_T !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a !! previous call to int_tide_init. ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - speed ! The magnitude of the group velocity at the q points for corner adv [m s-1]. + speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. integer, parameter :: stencil = 2 real, dimension(SZIB_(G),SZJ_(G)) :: & - speed_x ! The magnitude of the group velocity at the Cu points [m s-1]. + speed_x ! The magnitude of the group velocity at the Cu points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & - speed_y ! The magnitude of the group velocity at the Cv points [m s-1]. + speed_y ! The magnitude of the group velocity at the Cv points [L T-1 ~> m s-1]. real, dimension(0:NAngle) :: & cos_angle, sin_angle real, dimension(NAngle) :: & Cgx_av, Cgy_av, dCgx, dCgy real :: f2 ! The squared Coriolis parameter [s-2]. real :: Angle_size, I_Angle_size, angle - real :: Ifreq, freq2 - real, parameter :: cn_subRO = 1e-100 + real :: Ifreq ! The inverse of the frequency [T ~> s] + real :: freq2 ! The frequency squared [T-2 ~> s-2] type(loop_bounds_type) :: LB integer :: is, ie, js, je, asd, aed, na integer :: ish, ieh, jsh, jeh @@ -1010,14 +1011,14 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Fix indexing here later speed(:,:) = 0 do J=jsh-1,jeh ; do I=ish-1,ieh - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 + f2 = G%CoriolisBu(I,J)**2 speed(I,J) = 0.25*(cn(i,j) + cn(i+1,j) + cn(i+1,j+1) + cn(i,j+1)) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do a=1,na ! Apply the propagation WITH CORNER ADVECTION/FINITE VOLUME APPROACH. LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie - call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt, G, CS, LB) + call propagate_corner_spread(En(:,:,a), a, NAngle, speed, dt_in_T, G, CS, LB) enddo ! a-loop else ! IMPLEMENT PPM ADVECTION IN HORIZONTAL----------------------- @@ -1040,19 +1041,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) enddo do j=jsh,jeh ; do I=ish-1,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I,J-1)**2) speed_x(I,j) = 0.5*(cn(i,j) + cn(i+1,j)) * G%mask2dCu(I,j) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo do J=jsh-1,jeh ; do i=ish,ieh - f2 = 0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) + f2 = 0.5 * (G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J)**2) speed_y(i,J) = 0.5*(cn(i,j) + cn(i,j+1)) * G%mask2dCv(i,J) * & sqrt(max(freq2 - f2, 0.0)) * Ifreq enddo ; enddo ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt, G, CS%nAngle, CS, LB) + call propagate_x(En(:,:,:), speed_x, Cgx_av(:), dCgx(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_x') @@ -1063,29 +1064,29 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt, G, CS%nAngle, CS, LB) + call propagate_y(En(:,:,:), speed_y, Cgy_av(:), dCgy(:), dt_in_T, G, US, CS%nAngle, CS, LB) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G,CS,En(:,:,:),'post-propagate_y') - endif + end subroutine propagate !> This subroutine does first-order corner advection. It was written with the hopes !! of smoothing out the garden sprinkler effect, but is too numerically diffusive to !! be of much use as of yet. It is not yet compatible with reflection schemes (BDM). -subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS, LB) +subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt_in_T, G, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(inout) :: En !< The energy density integrated over an angular !! band [W m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & intent(in) :: speed !< The magnitude of the group velocity at the cell - !! corner points [m s-1]. + !! corner points [L T-1 ~> m s-1]. integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. type(int_tide_CS), pointer :: CS !< The control structure returned by a previous !! call to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1123,12 +1124,16 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS energized_angle = Angle_size * real(energized_wedge - 1) ! for a=1 aligned with x-axis !energized_angle = Angle_size * real(energized_wedge - 1) + 2.0*Angle_size ! !energized_angle = Angle_size * real(energized_wedge - 1) + 0.5*Angle_size ! - x = G%geoLonBu - y = G%geoLatBu - Idx = G%IdxBu; dx = G%dxBu - Idy = G%IdyBu; dy = G%dyBu + do J=jsh-1,jeh ; do I=ish-1,ieh + ! This will only work for a Cartesian grid for which G%geoLonBu is in the same units has dx. + ! This needs to be extensively revised to work for a general grid. + x(I,J) = G%US%m_to_L*G%geoLonBu(I,J) + y(I,J) = G%US%m_to_L*G%geoLatBu(I,J) + Idx(I,J) = G%IdxBu(I,J) ; dx(I,J) = G%dxBu(I,J) + Idy(I,J) = G%IdyBu(I,J) ; dy(I,J) = G%dyBu(I,J) + enddo ; enddo - do j=jsh,jeh; do i=ish,ieh + do j=jsh,jeh ; do i=ish,ieh do m=1,int(Nsubrays) theta = energized_angle - 0.5*Angle_size + real(m - 1)*Angle_size*I_Nsubwedges if (theta < 0.0) then @@ -1136,8 +1141,8 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS elseif (theta > TwoPi) then theta = theta - TwoPi endif - cos_thetaDT = cos(theta)*dt - sin_thetaDT = sin(theta)*dt + cos_thetaDT = cos(theta)*dt_in_T + sin_thetaDT = sin(theta)*dt_in_T ! corner point coordinates of advected fluid parcel ---------- xg = x(I,J); yg = y(I,J) @@ -1335,7 +1340,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1344,11 +1349,12 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the - !! Cu points [m s-1]. + !! Cu points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1381,25 +1387,19 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) cg_p(I) = speed_x(I,j) * (Cgx_av(a)) enddo call zonal_flux_En(cg_p, En(:,j,a), EnL(:,j), EnR(:,j), flux1, & - dt, G, j, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, j, ish, ieh, CS%vol_CFL) do I=ish-1,ieh ; flux_x(I,j) = flux1(I); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx (J) - Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx (J) + Fdt_m(i,j,a) = dt_in_T*flux_x(I-1,j) ! left face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_x(I,j) ! right face influx (J) enddo ; enddo - ! test with old (take out later) - !do j=LB%jsh,LB%jeh ; do i=LB%ish,LB%ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_x(I,j) - flux_x(I-1,j)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) @@ -1407,18 +1407,15 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) ! Update reflected energy (Jm-2) do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_x: OutFlux>Available") - ! endif - !enddo En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) enddo ; enddo end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt_in_T, G, US, Nangle, CS, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1427,11 +1424,12 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) !! band [J m-2], intent in/out. real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & intent(in) :: speed_y !< The magnitude of the group velocity at the - !! Cv points [m s-1]. + !! Cv points [L T-1 ~> m s-1]. real, dimension(Nangle), intent(in) :: Cgy_av !< The average y-projection in each angular band. real, dimension(Nangle), intent(in) :: dCgy !< The difference in y-projections between the !! edges of each angular band. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call !! to continuity_PPM_init. type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. @@ -1465,14 +1463,14 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) cg_p(i) = speed_y(i,J) * (Cgy_av(a)) enddo call merid_flux_En(cg_p, En(:,:,a), EnL(:,:), EnR(:,:), flux1, & - dt, G, J, ish, ieh, CS%vol_CFL) + dt_in_T, G, US, J, ish, ieh, CS%vol_CFL) do i=ish,ieh ; flux_y(i,J) = flux1(i); enddo enddo do j=jsh,jeh ; do i=ish,ieh - Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx (J) - Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx (J) - !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + Fdt_m(i,j,a) = dt_in_T*flux_y(i,J-1) ! south face influx (J) + Fdt_p(i,j,a) = -dt_in_T*flux_y(i,J) ! north face influx (J) + !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & ! "cn_south=", speed_y(i,J-1) * (Cgy_av(a)), "cn_north=", speed_y(i,J) * (Cgy_av(a)) @@ -1480,45 +1478,37 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) !endif enddo ; enddo - ! test with old (take out later) - !do j=jsh,jeh ; do i=ish,ieh - ! En(i,j,a) = En(i,j,a) - dt* G%IareaT(i,j) * (flux_y(i,J) - flux_y(i,J-1)) - !enddo ; enddo - enddo ! a-loop - ! Only reflect newly arrived energy; existing energy in incident wedge - ! is not reflected and will eventually propagate out of cell. - ! (only reflects if En > 0) + ! Only reflect newly arrived energy; existing energy in incident wedge is not reflected + ! and will eventually propagate out of cell. (Thid code only reflects if En > 0) call reflect(Fdt_m(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_m(:,:,:), Nangle, CS, G, LB) call reflect(Fdt_p(:,:,:), Nangle, CS, G, LB) call teleport(Fdt_p(:,:,:), Nangle, CS, G, LB) ! Update reflected energy (Jm-2) - do j=jsh,jeh ; do i=ish,ieh - !do a=1,CS%nAngle - ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0)then ! for debugging + do a=1,Nangle ; do j=jsh,jeh ; do i=ish,ieh + ! if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) & ! for debugging ! call MOM_error(FATAL, "propagate_y: OutFlux>Available", .true.) - ! endif - !enddo - En(i,j,:) = En(i,j,:) + G%IareaT(i,j)*(Fdt_m(i,j,:) + Fdt_p(i,j,:)) - enddo ; enddo + En(i,j,a) = En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a)) + enddo ; enddo ; enddo end subroutine propagate_y !> Evaluates the zonal mass or volume fluxes in a layer. -subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) +subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, US, j, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [m s-1]. + real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction !! [J m-2]. real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction !! [J m-2]. - real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -1551,17 +1541,18 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) end subroutine zonal_flux_En !> Evaluates the meridional mass or volume fluxes in a layer. -subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) +subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, US, J, ish, ieh, vol_CFL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [m s-1]. + real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the !! fluxes [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the !! reconstruction [J m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the !! reconstruction [J m-2]. - real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [J s-1]. - real, intent(in) :: dt !< Time increment [s]. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport [L2 T-1 J m-2 ~> J s-1]. + real, intent(in) :: dt !< Time increment [T ~> s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: J !< The j-index to work on. integer, intent(in) :: ish !< The start i-index range to work on. integer, intent(in) :: ieh !< The end i-index range to work on. @@ -2122,7 +2113,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! array for temporary storage of flags ! of cells with double-reflecting ridges logical :: use_int_tides, use_temperature - integer :: num_angle, num_freq, num_mode, m, fr, period_1 + real :: period_1 ! The period of the gravest modeled mode [T ~> s] + integer :: num_angle, num_freq, num_mode, m, fr integer :: isd, ied, jsd, jed, a, id_ang, i, j type(axes_grp) :: axes_ang ! This include declares and sets the variable "version". @@ -2176,7 +2168,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) - call read_param(param_file, "FIRST_MODE_PERIOD", period_1); ! ADDED BDM + call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, units="s", scale=US%s_to_T) do fr=1,num_freq CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM enddo @@ -2280,7 +2272,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & - units="m-1", default=8.e-4*atan(1.0)) + units="m-1", default=8.e-4*atan(1.0), scale=US%L_to_m) call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) @@ -2315,8 +2307,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) ! Compute the fixed part; units are [kg m-2] here ! will be multiplied by N and En to get into [W m-2] - CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& - kappa_itides * h2(i,j) + CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) enddo ; enddo deallocate(h2) @@ -2387,8 +2378,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !call MOM_read_data(filename, 'land_mask', G%mask2dCu, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dCv, G%domain, timelevel=1) !call MOM_read_data(filename, 'land_mask', G%mask2dT, G%domain, timelevel=1) - !call pass_var(G%mask2dCu,G%domain) - !call pass_var(G%mask2dCv,G%domain) + !call pass_vector(G%mask2dCu, G%mask2dCv, G%domain, To_All+Scalar_Pair, CGRID_NE) !call pass_var(G%mask2dT,G%domain) ! Read in prescribed partial east face blockages from file (if overwriting -BDM) @@ -2398,8 +2388,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dy_Cu_file) !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) !G%dy_Cu(:,:) = 0.0 - !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1) - !call pass_var(G%dy_Cu,G%domain) + !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, timelevel=1, scale=US%m_to_L) ! Read in prescribed partial north face blockages from file (if overwriting -BDM) !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & @@ -2408,8 +2397,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !filename = trim(CS%inputdir) // trim(dx_Cv_file) !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) !G%dx_Cv(:,:) = 0.0 - !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1) - !call pass_var(G%dx_Cv,G%domain) + !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, timelevel=1, scale=US%m_to_L) + !call pass_vector(G%dy_Cu, G%dx_Cv, G%domain, To_All+Scalar_Pair, CGRID_NE) ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & @@ -2417,9 +2406,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_refl_pref = register_diag_field('ocean_model', 'refl_pref', diag%axesT1, & Time, 'Partial reflection coefficients', '') CS%id_dx_Cv = register_diag_field('ocean_model', 'dx_Cv', diag%axesT1, & - Time, 'North face unblocked width', 'm') ! used if overriding (BDM) + Time, 'North face unblocked width', 'm', conversion=US%L_to_m) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & - Time, 'East face unblocked width', 'm') ! used if overriding (BDM) + Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & Time, 'Land mask', 'logical') ! used if overriding (BDM) ! Output reflection parameters as diags here (not needed every timestep) @@ -2508,14 +2497,14 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Near-bottom horizonal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + 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 horizonal phase velocity for each freq and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Horizonal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & - diag%axesT1, Time, var_descript, 'm s-1') + 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 ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 3a7d2a01a1..1582b23615 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -41,11 +41,6 @@ module MOM_lateral_mixing_coeffs !! of first baroclinic wave for calculating the resolution fn. logical :: khth_use_ebt_struct !< If true, uses the equivalent barotropic structure !! as the vertical structure of thickness diffusivity. - logical :: use_Visbeck_slope_bug !< If true, then retain a legacy bug in the calculation of weights - !! applied to isoneutral slopes. There was an erroneous k-indexing - !! for layer thicknesses. In addition, masking at coastlines was not - !! used which introduced potential restart issues. This flag will be - !! deprecated in a future release. logical :: calculate_cg1 !< If true, calls wave_speed() to calculate the first !! baroclinic wave speed and populate CS%cg1. !! This parameter is set depending on other parameters. @@ -56,54 +51,55 @@ module MOM_lateral_mixing_coeffs logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. !! This parameter is set depending on other parameters. real, dimension(:,:), pointer :: & - SN_u => NULL(), & !< S*N at u-points [s-1] - SN_v => NULL(), & !< S*N at v-points [s-1] - L2u => NULL(), & !< Length scale^2 at u-points [m2] - L2v => NULL(), & !< Length scale^2 at v-points [m2] - cg1 => NULL(), & !< The first baroclinic gravity wave speed [m s-1]. + SN_u => NULL(), & !< S*N at u-points [T-1 ~> s-1] + SN_v => NULL(), & !< S*N at v-points [T-1 ~> s-1] + L2u => NULL(), & !< Length scale^2 at u-points [L2 ~> m2] + L2v => NULL(), & !< Length scale^2 at v-points [L2 ~> m2] + cg1 => NULL(), & !< The first baroclinic gravity wave speed [L T-1 ~> m s-1]. Res_fn_h => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at h points. + !! deformation radius to the grid spacing at h points [nondim]. Res_fn_q => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at q points. + !! deformation radius to the grid spacing at q points [nondim]. Res_fn_u => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at u points. + !! deformation radius to the grid spacing at u points [nondim]. Res_fn_v => NULL(), & !< Non-dimensional function of the ratio the first baroclinic - !! deformation radius to the grid spacing at v points. + !! deformation radius to the grid spacing at v points [nondim]. beta_dx2_h => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at h points. + !! times the grid spacing squared at h points [L T-1 ~> m s-1]. beta_dx2_q => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at q points. + !! times the grid spacing squared at q points [L T-1 ~> m s-1]. beta_dx2_u => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at u points. + !! times the grid spacing squared at u points [L T-1 ~> m s-1]. beta_dx2_v => NULL(), & !< The magnitude of the gradient of the Coriolis parameter - !! times the grid spacing squared at v points. + !! times the grid spacing squared at v points [L T-1 ~> m s-1]. f2_dx2_h => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at h [m-2 s-2]. + !! spacing squared at h [L2 T-2 ~> m2 s-2]. f2_dx2_q => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at q [m-2 s-2]. + !! spacing squared at q [L2 T-2 ~> m2 s-2]. f2_dx2_u => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at u [m-2 s-2]. + !! spacing squared at u [L2 T-2 ~> m2 s-2]. f2_dx2_v => NULL(), & !< The Coriolis parameter squared times the grid - !! spacing squared at v [m-2 s-2]. + !! spacing squared at v [L2 T-2 ~> m2 s-2]. Rd_dx_h => NULL() !< Deformation radius over grid spacing [nondim] real, dimension(:,:,:), pointer :: & slope_x => NULL(), & !< Zonal isopycnal slope [nondim] slope_y => NULL(), & !< Meridional isopycnal slope [nondim] + !### These are posted as diagnostics but are never set. N2_u => NULL(), & !< Brunt-Vaisala frequency at u-points [s-2] N2_v => NULL(), & !< Brunt-Vaisala frequency at v-points [s-2] ebt_struct => NULL() !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - Laplac3_const_u !< Laplacian metric-dependent constants [nondim] + Laplac3_const_u !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - Laplac3_const_v !< Laplacian metric-dependent constants [nondim] + Laplac3_const_v !< Laplacian metric-dependent constants [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - KH_u_QG !< QG Leith GM coefficient at u-points [m2 s-1] + KH_u_QG !< QG Leith GM coefficient at u-points [L2 T-1 ~> m2 s-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - KH_v_QG !< QG Leith GM coefficient at v-points [m2 s-1] + KH_v_QG !< QG Leith GM coefficient at v-points [L2 T-1 ~> m2 s-1] ! Parameters logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity @@ -115,7 +111,7 @@ module MOM_lateral_mixing_coeffs real :: Res_coef_visc !< A non-dimensional number that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 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. @@ -156,11 +152,14 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients + ! Local variables - real :: cg1_q ! The gravity wave speed interpolated to q points [m s-1]. - real :: cg1_u ! The gravity wave speed interpolated to u points [m s-1]. - real :: cg1_v ! The gravity wave speed interpolated to v points [m s-1]. - real :: dx_term + ! Depending on the power-function being used, dimensional rescaling may be limited, so some + ! of the following variables have units that depend on that power. + real :: cg1_q ! The gravity wave speed interpolated to q points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_u ! The gravity wave speed interpolated to u points [L T-1 ~> m s-1] or [m s-1]. + real :: cg1_v ! The gravity wave speed interpolated to v points [L T-1 ~> m s-1] or [m s-1]. + real :: dx_term ! A term in the denominator [L2 T-2 ~> m2 s-2] or [m2 s-2] integer :: power_2 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k @@ -189,6 +188,10 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed_CSp) endif + do j=js,je ; do i=is,ie + CS%cg1(i,j) = US%m_s_to_L_T*CS%cg1(i,j) + enddo ; enddo + call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) call do_group_pass(CS%pass_cg1, G%Domain) endif @@ -198,13 +201,11 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%calculate_rd_dx) then if (.not. associated(CS%Rd_dx_h)) call MOM_error(FATAL, & "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") -!$OMP parallel default(none) shared(is,ie,js,je,CS) -!$OMP do + !$OMP parallel do default(shared) do j=js-1,je+1 ; do i=is-1,ie+1 CS%Rd_dx_h(i,j) = CS%cg1(i,j) / & (sqrt(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))) enddo ; enddo -!$OMP end parallel if (query_averaging_enabled(CS%diag)) then if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) endif @@ -254,8 +255,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) if ((CS%Res_coef_visc * cg1_q)**2 > dx_term) then CS%Res_fn_q(I,J) = 0.0 @@ -271,8 +271,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) dx_term = CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J) CS%Res_fn_q(I,J) = dx_term / (dx_term + (CS%Res_coef_visc * cg1_q)**2) enddo ; enddo @@ -280,34 +279,32 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) power_2 = CS%Res_fn_power_visc / 2 !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))**power_2 + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**power_2 CS%Res_fn_h(i,j) = dx_term / & - (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J))**power_2 + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + dx_term = (US%L_T_to_m_s**2*(CS%f2_dx2_q(I,J) + cg1_q * CS%beta_dx2_q(I,J)))**power_2 CS%Res_fn_q(I,J) = dx_term / & - (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo else !$OMP do do j=js-1,je+1 ; do i=is-1,ie+1 - dx_term = (sqrt(CS%f2_dx2_h(i,j) + & - CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_h(i,j) + & + CS%cg1(i,j)*CS%beta_dx2_h(i,j)))**CS%Res_fn_power_visc CS%Res_fn_h(i,j) = dx_term / & - (dx_term + (CS%Res_coef_visc * CS%cg1(i,j))**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*CS%cg1(i,j))**CS%Res_fn_power_visc) enddo ; enddo !$OMP do do J=js-1,Jeq ; do I=is-1,Ieq - cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + & - (CS%cg1(i+1,j) + CS%cg1(i,j+1))) - dx_term = (sqrt(CS%f2_dx2_q(I,J) + & - cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc + cg1_q = 0.25 * ((CS%cg1(i,j) + CS%cg1(i+1,j+1)) + (CS%cg1(i+1,j) + CS%cg1(i,j+1))) + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_q(I,J) + & + cg1_q * CS%beta_dx2_q(I,J)))**CS%Res_fn_power_visc CS%Res_fn_q(I,J) = dx_term / & - (dx_term + (CS%Res_coef_visc * cg1_q)**CS%Res_fn_power_visc) + (dx_term + (CS%Res_coef_visc * US%L_T_to_m_s*cg1_q)**CS%Res_fn_power_visc) enddo ; enddo endif @@ -358,33 +355,33 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) !$OMP do do j=js,je ; do I=is-1,Ieq cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j))**power_2 + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_u(I,j) + cg1_u * CS%beta_dx2_u(I,j)))**power_2 CS%Res_fn_u(I,j) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J))**power_2 + dx_term = (US%L_T_to_m_s**2 * (CS%f2_dx2_v(i,J) + cg1_v * CS%beta_dx2_v(i,J)))**power_2 CS%Res_fn_v(i,J) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo else !$OMP do do j=js,je ; do I=is-1,Ieq cg1_u = 0.5 * (CS%cg1(i,j) + CS%cg1(i+1,j)) - dx_term = (sqrt(CS%f2_dx2_u(I,j) + & - cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_u(I,j) + & + cg1_u * CS%beta_dx2_u(I,j)))**CS%Res_fn_power_khth CS%Res_fn_u(I,j) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_u)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_u)**CS%Res_fn_power_khth) enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie cg1_v = 0.5 * (CS%cg1(i,j) + CS%cg1(i,j+1)) - dx_term = (sqrt(CS%f2_dx2_v(i,J) + & - cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth + dx_term = (US%L_T_to_m_s*sqrt(CS%f2_dx2_v(i,J) + & + cg1_v * CS%beta_dx2_v(i,J)))**CS%Res_fn_power_khth CS%Res_fn_v(i,J) = dx_term / & - (dx_term + (CS%Res_coef_khth * cg1_v)**CS%Res_fn_power_khth) + (dx_term + (CS%Res_coef_khth * US%L_T_to_m_s*cg1_v)**CS%Res_fn_power_khth) enddo ; enddo endif endif @@ -409,7 +406,7 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [s-2] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: N2_u ! Square of Brunt-Vaisala freq at u-points [T-2 ~> s-2] real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: N2_v ! Square of Brunt-Vaisala freq at v-points [s-2] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& @@ -418,9 +415,9 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%calculate_Eady_growth_rate) then call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, & + call calc_isoneutral_slopes(G, GV, US, h, e, tv, US%s_to_T*dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) - call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, CS) + call calc_Visbeck_coeffs(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) ! call calc_slope_functions_using_just_e(h, G, CS, e, .false.) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) @@ -433,6 +430,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) + !### I do not believe that CS%N2_u and CS%N2_v are ever set, but because the contents + ! of CS are public, they might be set somewhere outside of this module. if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, CS%N2_u, CS%diag) if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, CS%N2_v, CS%diag) endif @@ -440,19 +439,22 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS) end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al. -subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) +subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: slope_x !< Zonal isoneutral slope - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points [s-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency + !! at u-points [T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points [s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency + !! at v-points [T-2 ~> s-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency [s-1] + real :: N2 ! Positive buoyancy frequency or zero [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. integer :: is, ie, js, je, nz @@ -495,26 +497,16 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) H_geom = sqrt( Hdn * Hup ) !H_geom = H_geom * sqrt(N2) ! WKB-ish !H_geom = H_geom * N2 ! WKB-ish - if (CS%use_Visbeck_slope_bug) then - wSE = h(i+1,j,k)*h(i+1,j-1,k) * h(i+1,j,k)*h(i+1,j-1,k-1) - wNW = h(i ,j,k)*h(i ,j+1,k) * h(i ,j,k)*h(i ,j+1,k-1) - wNE = h(i+1,j,k)*h(i+1,j+1,k) * h(i+1,j,k)*h(i+1,j+1,k-1) - wSW = h(i ,j,k)*h(i ,j-1,k) * h(i ,j,k)*h(i ,j-1,k-1) - S2 = slope_x(I,j,K)**2 + ( & - (wNW*slope_y(i,J,K)**2+wSE*slope_y(i+1,J-1,K)**2) & - +(wNE*slope_y(i+1,J,K)**2+wSW*slope_y(i,J-1,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**2 ) !### This should be **4 for consistent units. - else - wSE = G%mask2dCv(i+1,J-1) * ( (h(i+1,j,k)*h(i+1,j-1,k)) * (h(i+1,j,k-1)*h(i+1,j-1,k-1)) ) - wNW = G%mask2dCv(i ,J ) * ( (h(i ,j,k)*h(i ,j+1,k)) * (h(i ,j,k-1)*h(i ,j+1,k-1)) ) - wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) ) - wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) ) - S2 = slope_x(I,j,K)**2 + ( & - (wNW*slope_y(i,J,K)**2+wSE*slope_y(i+1,J-1,K)**2) & - +(wNE*slope_y(i+1,J,K)**2+wSW*slope_y(i,J-1,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) - endif + wSE = G%mask2dCv(i+1,J-1) * ( (h(i+1,j,k)*h(i+1,j-1,k)) * (h(i+1,j,k-1)*h(i+1,j-1,k-1)) ) + wNW = G%mask2dCv(i ,J ) * ( (h(i ,j,k)*h(i ,j+1,k)) * (h(i ,j,k-1)*h(i ,j+1,k-1)) ) + wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) ) + wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) ) + S2 = slope_x(I,j,K)**2 + & + ((wNW*slope_y(i,J,K)**2 + wSE*slope_y(i+1,J-1,K)**2) + & + (wNE*slope_y(i+1,J,K)**2 + wSW*slope_y(i,J-1,K)**2) ) / & + ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 + N2 = max(0., N2_u(I,j,k)) CS%SN_u(I,j) = CS%SN_u(I,j) + sqrt( S2*N2 )*H_geom S2_u(I,j) = S2_u(I,j) + S2*H_geom @@ -541,26 +533,16 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) H_geom = sqrt( Hdn * Hup ) !H_geom = H_geom * sqrt(N2) ! WKB-ish !H_geom = H_geom * N2 ! WKB-ish - if (CS%use_Visbeck_slope_bug) then - wSE = h(i,j ,k)*h(i+1,j ,k) * h(i,j ,k)*h(i+1,j ,k-1) - wNW = h(i,j+1,k)*h(i-1,j+1,k) * h(i,j+1,k)*h(i-1,j+1,k-1) - wNE = h(i,j+1,k)*h(i+1,j+1,k) * h(i,j+1,k)*h(i+1,j+1,k-1) - wSW = h(i,j ,k)*h(i-1,j ,k) * h(i,j ,k)*h(i-1,j ,k-1) - S2 = slope_y(i,J,K)**2 + ( & - (wSE*slope_x(I,j,K)**2+wNW*slope_x(I-1,j+1,K)**2) & - +(wNE*slope_x(I,j+1,K)**2+wSW*slope_x(I-1,j,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**2 ) !### This should be **4 for consistent units. - else - wSE = G%mask2dCu(I,j) * ( (h(i,j ,k)*h(i+1,j ,k)) * (h(i,j ,k-1)*h(i+1,j ,k-1)) ) - wNW = G%mask2dCu(I-1,j+1) * ( (h(i,j+1,k)*h(i-1,j+1,k)) * (h(i,j+1,k-1)*h(i-1,j+1,k-1)) ) - wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) ) - wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) ) - S2 = slope_y(i,J,K)**2 + ( & - (wSE*slope_x(I,j,K)**2+wNW*slope_x(I-1,j+1,K)**2) & - +(wNE*slope_x(I,j+1,K)**2+wSW*slope_x(I-1,j,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) !### This should be **4 for consistent units. - endif + wSE = G%mask2dCu(I,j) * ( (h(i,j ,k)*h(i+1,j ,k)) * (h(i,j ,k-1)*h(i+1,j ,k-1)) ) + wNW = G%mask2dCu(I-1,j+1) * ( (h(i,j+1,k)*h(i-1,j+1,k)) * (h(i,j+1,k-1)*h(i-1,j+1,k-1)) ) + wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) ) + wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) ) + S2 = slope_y(i,J,K)**2 + & + ((wSE*slope_x(I,j,K)**2 + wNW*slope_x(I-1,j+1,K)**2) + & + (wNE*slope_x(I,j+1,K)**2 + wSW*slope_x(I-1,j,K)**2) ) / & + ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 + N2 = max(0., N2_v(i,J,K)) CS%SN_v(i,J) = CS%SN_v(i,J) + sqrt( S2*N2 )*H_geom S2_v(i,J) = S2_v(i,J) + S2*H_geom @@ -584,8 +566,8 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) if (CS%debug) then call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) - call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) - call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI) + call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI, scale=US%s_to_T**2) + call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI, scale=US%s_to_T) endif end subroutine calc_Visbeck_coeffs @@ -608,16 +590,14 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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 [nondim] - real :: N2 ! Brunt-Vaisala frequency [s-1] + real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances. real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. integer :: is, ie, js, je, nz integer :: i, j, k, kb_max - real :: SN_u_local(SZIB_(G), SZJ_(G),SZK_(G)) - real :: SN_v_local(SZI_(G), SZJB_(G),SZK_(G)) + real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(G)) + real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(G)) if (.not. associated(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") @@ -632,7 +612,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) - Z_to_L = US%Z_to_m ! 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 @@ -644,12 +623,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = US%Z_to_L*(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. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = US%Z_to_L*(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. enddo ; enddo @@ -671,10 +650,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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)*US%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) 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 - SN_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 + S2N2_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & @@ -682,10 +661,10 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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)*US%m_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) 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 - SN_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 + S2N2_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo enddo ! k @@ -693,7 +672,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do j=js,je do I=is-1,ie ; CS%SN_u(I,j) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do I=is-1,ie - CS%SN_u(I,j) = CS%SN_u(I,j) + SN_u_local(I,j,k) + 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 @@ -711,7 +690,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop do J=js-1,je do i=is,ie ; CS%SN_v(i,J) = 0.0 ; enddo do k=nz,CS%VarMix_Ktop,-1 ; do i=is,ie - CS%SN_v(i,J) = CS%SN_v(i,J) + SN_v_local(i,J,k) + CS%SN_v(i,J) = CS%SN_v(i,J) + S2N2_v_local(i,J,k) enddo ; enddo do i=is,ie !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + GV%Angstrom_Z ) )) @@ -728,22 +707,23 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop end subroutine calc_slope_functions_using_just_e !> Calculates the Leith Laplacian and bi-harmonic viscosity coefficients -subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) +subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vort_xy_dx, vort_xy_dy) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal flow [m s-1] ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional flow [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] integer, intent(in) :: k !< Layer for which to calculate vorticity magnitude - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence - !! (d/dx(du/dx + dv/dy)) [m-1 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence - !! (d/dy(du/dx + dv/dy)) [m-1 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: div_xx_dx !< x-derivative of horizontal divergence + !! (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: div_xx_dy !< y-derivative of horizontal divergence + !! (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vort_xy_dx !< x-derivative of vertical vorticity - !! (d/dx(dv/dx - du/dy)) [m-1 s-1] + !! (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: vort_xy_dy !< y-derivative of vertical vorticity - !! (d/dy(dv/dx - du/dy)) [m-1 s-1] + !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! real, dimension(SZI_(G),SZJ_(G)), intent(out) :: Leith_Kh_h !< Leith Laplacian viscosity !! at h-points [m2 s-1] ! real, dimension(SZIB_(G),SZJB_(G)), intent(out) :: Leith_Kh_q !< Leith Laplacian viscosity @@ -758,25 +738,26 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x ! dudy, & ! Meridional shear of zonal velocity [s-1] ! dvdx ! Zonal shear of meridional velocity [s-1] real, dimension(SZI_(G),SZJB_(G)) :: & -! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [m-1 s-1] -! div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [m-1 s-1] - dslopey_dz, & ! z-derivative of y-slope at v-points [m-1] +! vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [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] + dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] - beta_v, & ! Beta at v-points [m-1 s-1] - grad_vort_mag_v, & ! mag. of vort. grad. at v-points [s-1] - grad_div_mag_v ! mag. of div. grad. at v-points [s-1] + beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-1] + grad_vort_mag_v, & ! Magnitude of vorticity gradient at v-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_v ! Magnitude of divergence gradient at v-points [T-1 L-1 ~> s-1 m-1] real, dimension(SZIB_(G),SZJ_(G)) :: & -! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [m-1 s-1] -! div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [m-1 s-1] - dslopex_dz, & ! z-derivative of x-slope at u-points (m-1) +! vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [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] + dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] - beta_u, & ! Beta at u-points [m-1 s-1] - grad_vort_mag_u, & ! mag. of vort. grad. at u-points [s-1] - grad_div_mag_u ! mag. of div. grad. at u-points [s-1] + beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] + grad_vort_mag_u, & ! Magnitude of vorticity gradient at u-points [T-1 L-1 ~> s-1 m-1] + grad_div_mag_u ! Magnitude of divergence gradient at u-points [T-1 L-1 ~> s-1 m-1] ! real, dimension(SZI_(G),SZJ_(G)) :: div_xx ! Estimate of horizontal divergence at h-points [s-1] ! real :: mod_Leith, DY_dxBu, DX_dyBu, vert_vort_mag - real :: h_at_slope_above, h_at_slope_below, Ih, f + real :: h_at_slope_above, h_at_slope_below, Ih + real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz real :: inv_PI3 @@ -786,14 +767,15 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x inv_PI3 = 1.0/((4.0*atan(1.0))**3) - ! update halos + !### I believe this halo update to be unnecessary. -RWH call pass_var(h, G%Domain) if ((k > 1) .and. (k < nz)) then ! Add in stretching term for the QG Leith vsicosity ! if (CS%use_QG_Leith) then -! do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 + + !### do j=js-1,je+1 ; do I=is-2,Ieq+1 do j=js-2,Jeq+2 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( 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) + h(i+1,j,k) ) & @@ -801,11 +783,12 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x 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 ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + 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 h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo -! do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 + + !### do J=js-2,Jeq+1 ; do i=is-1,ie+1 do J=js-2,Jeq+1 ; do i=is-2,Ieq+2 h_at_slope_above = 2. * ( 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) + h(i,j+1,k) ) & @@ -813,73 +796,78 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, h, k, div_xx_dx, div_xx_dy, vort_x 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 ) - Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_m ) + 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 h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + !### do J=js-1,je ; do i=is-1,Ieq+1 do J=js-2,Jeq+1 ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) - vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo + !### do j=js-1,Jeq+1 ; do I=is-1,ie do j=js-1,Jeq+1 ; do I=is-2,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) - vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * & + !### I think that this should be vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & + vort_xy_dy(I,j) = vort_xy_dx(I,j) - f * US%L_to_Z * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) enddo ; enddo endif ! k > 1 + !### I believe this halo update to be unnecessary. -RWH call pass_vector(vort_xy_dy,vort_xy_dx,G%Domain) - if (CS%use_QG_Leith_GM) then + if (CS%use_QG_Leith_GM) then + + do j=js,je ; do I=is-1,Ieq + !### These expressions are not rotationally symmetric. Add parentheses and regroup, as in: + ! grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*((vort_xy_dx(i,J) + vort_xy_dx(i+1,J-1)) + + ! (vort_xy_dx(i+1,J) + vort_xy_dx(i,J-1))))**2 ) + grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & + + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) + grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & + + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) if (CS%use_beta_in_QG_Leith) then - do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 - beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) - enddo ; enddo - do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 - beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & - (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) - enddo ; enddo + beta_u(I,j) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i+1,j))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i+1,j))**2) ) + CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), 3.0*beta_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 + else + CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) * & + CS%Laplac3_const_u(I,j) * inv_PI3 endif + enddo ; enddo - do j=js-1,Jeq+1 ; do I=is-2,Ieq - grad_vort_mag_u(I,j) = SQRT(vort_xy_dy(I,j)**2 + (0.25*(vort_xy_dx(i,J) + vort_xy_dx(i+1,J) & - + vort_xy_dx(i,J-1) + vort_xy_dx(i+1,J-1)))**2) - grad_div_mag_u(I,j) = SQRT(div_xx_dx(I,j)**2 + (0.25*(div_xx_dy(i,J) + div_xx_dy(i+1,J) & - + div_xx_dy(i,J-1) + div_xx_dy(i+1,J-1)))**2) - if (CS%use_beta_in_QG_Leith) then - CS%KH_u_QG(I,j,k) = MIN(grad_vort_mag_u(I,j) + grad_div_mag_u(I,j), beta_u(I,j)*3) & - * CS%Laplac3_const_u(I,j) * inv_PI3 - else - CS%KH_u_QG(I,j,k) = (grad_vort_mag_u(I,j) + grad_div_mag_u(I,j)) & - * CS%Laplac3_const_u(I,j) * inv_PI3 - endif - enddo ; enddo + do J=js-1,Jeq ; do i=is,ie + !### These expressions are not rotationally symmetric. Add parentheses and regroup. + grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & + + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) + grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & + + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) + if (CS%use_beta_in_QG_Leith) then + beta_v(i,J) = sqrt( (0.5*(G%dF_dx(i,j)+G%dF_dx(i,j+1))**2) + & + (0.5*(G%dF_dy(i,j)+G%dF_dy(i,j+1))**2) ) + CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), 3.0*beta_v(i,J)) * & + CS%Laplac3_const_v(i,J) * inv_PI3 + else + CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) * & + CS%Laplac3_const_v(i,J) * inv_PI3 + endif + enddo ; enddo + ! post diagnostics - do J=js-2,Jeq ; do i=is-1,Ieq+1 - grad_vort_mag_v(i,J) = SQRT(vort_xy_dx(i,J)**2 + (0.25*(vort_xy_dy(I,j) + vort_xy_dy(I-1,j) & - + vort_xy_dy(I,j+1) + vort_xy_dy(I-1,j+1)))**2) - grad_div_mag_v(i,J) = SQRT(div_xx_dy(i,J)**2 + (0.25*(div_xx_dx(I,j) + div_xx_dx(I-1,j) & - + div_xx_dx(I,j+1) + div_xx_dx(I-1,j+1)))**2) - if (CS%use_beta_in_QG_Leith) then - CS%KH_v_QG(i,J,k) = MIN(grad_vort_mag_v(i,J) + grad_div_mag_v(i,J), beta_v(i,J)*3) & - * CS%Laplac3_const_v(i,J) * inv_PI3 - else - CS%KH_v_QG(i,J,k) = (grad_vort_mag_v(i,J) + grad_div_mag_v(i,J)) & - * CS%Laplac3_const_v(i,J) * inv_PI3 - endif - enddo ; enddo - ! post diagnostics + if (k==nz) then if (CS%id_KH_v_QG > 0) call post_data(CS%id_KH_v_QG, CS%KH_v_QG, CS%diag) if (CS%id_KH_u_QG > 0) call post_data(CS%id_KH_u_QG, CS%KH_u_QG, CS%diag) endif + endif end subroutine calc_QG_Leith_viscosity @@ -895,14 +883,13 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo, N2_filter_depth real :: KhTr_passivity_coeff - real :: absurdly_small_freq2 ! A miniscule frequency - ! squared that is used to avoid division by 0 [s-2]. This - ! value is roughly (pi / (the age of the universe) )^2. + 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 real :: MLE_front_length real :: Leith_Lap_const ! The non-dimensional coefficient in the Leith viscosity - real :: grid_sp_u2, grid_sp_u3 - real :: grid_sp_v2, grid_sp_v3 ! Intermediate quantities for Leith metrics + real :: grid_sp_u2, grid_sp_v2 ! Intermediate quantities for Leith metrics [L2 ~> m2] + real :: grid_sp_u3, grid_sp_v3 ! Intermediate quantities for Leith metrics [L3 ~> m3] ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -926,7 +913,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%calculate_Rd_dx = .false. CS%calculate_res_fns = .false. CS%calculate_Eady_growth_rate = .false. - absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -972,6 +958,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "stored for re-use. This uses more memory but avoids calling "//& "the equation of state more times than should be necessary.", & default=.false.) + call get_param(param_file, mdl, "VERY_SMALL_FREQUENCY", absurdly_small_freq, & + "A miniscule frequency that is used to avoid division by 0. The default "//& + "value is roughly (pi / (the age of the universe)).", & + default=1.0e-17, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn @@ -993,7 +983,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) 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.) + units="m", default=2000.) allocate(CS%ebt_struct(isd:ied,jsd:jed,G%ke)) ; CS%ebt_struct(:,:,:) = 0.0 endif @@ -1015,7 +1005,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.", & - default=1.0e-6, scale=US%m_to_Z**2) !### Add units argument. + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) endif if (CS%calculate_Eady_growth_rate) then @@ -1023,9 +1013,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%SN_u(IsdB:IedB,jsd:jed)) ; CS%SN_u(:,:) = 0.0 allocate(CS%SN_v(isd:ied,JsdB:JedB)) ; CS%SN_v(:,:) = 0.0 CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & - 'Inverse eddy time-scale, S*N, at u-points', 's-1') + 'Inverse eddy time-scale, S*N, at u-points', 's-1', conversion=US%s_to_T) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & - 'Inverse eddy time-scale, S*N, at v-points', 's-1') + 'Inverse eddy time-scale, S*N, at v-points', 's-1', conversion=US%s_to_T) call get_param(param_file, mdl, "VARMIX_KTOP", CS%VarMix_Ktop, & "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & @@ -1041,20 +1031,22 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2*G%areaCu(I,j) + CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) enddo; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2*G%areaCv(i,J) + CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) enddo; enddo else - CS%L2u(:,:) = CS%Visbeck_L_scale**2 - CS%L2v(:,:) = CS%Visbeck_L_scale**2 + CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 + CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & - 'Length scale squared for mixing coefficient, at u-points', 'm2') + 'Length scale squared for mixing coefficient, at u-points', & + 'm2', conversion=US%L_to_m**2) CS%id_L2v = register_diag_field('ocean_model', 'L2v', diag%axesCv1, Time, & - 'Length scale squared for mixing coefficient, at v-points', 'm2') + 'Length scale squared for mixing coefficient, at v-points', & + 'm2', conversion=US%L_to_m**2) endif if (CS%use_stored_slopes) then @@ -1115,12 +1107,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "velocity points from the thickness points; otherwise "//& "interpolate the wave speed and calculate the resolution "//& "function independently at each point.", default=.true.) - call get_param(param_file, mdl, "USE_VISBECK_SLOPE_BUG", CS%use_Visbeck_slope_bug, & - "If true, then retain a legacy bug in the calculation of weights "//& - "applied to isoneutral slopes. There was an erroneous k-indexing "//& - "for layer thicknesses. In addition, masking at coastlines was not "//& - "used which introduced potential restart issues. This flag will be "//& - "deprecated in a future release.", default=.false.) if (CS%interpolate_Res_fn) then if (CS%Res_coef_visc /= CS%Res_coef_khth) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& @@ -1142,8 +1128,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & - max(US%s_to_T**2 * G%CoriolisBu(I,J)**2, absurdly_small_freq2) - CS%beta_dx2_q(I,J) = oneOrTwo * (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * (US%s_to_T * sqrt(0.5 * & + max(G%CoriolisBu(I,J)**2, absurdly_small_freq**2) + CS%beta_dx2_q(I,J) = oneOrTwo * ((G%dxBu(I,J))**2 + (G%dyBu(I,J))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1152,8 +1138,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) do j=js,je ; do I=is-1,Ieq CS%f2_dx2_u(I,j) = (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * & - max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq2) - CS%beta_dx2_u(I,j) = oneOrTwo * (G%dxCu(I,j)**2 + G%dyCu(I,j)**2) * (US%s_to_T * sqrt( & + max(0.5* (G%CoriolisBu(I,J)**2+G%CoriolisBu(I,J-1)**2), absurdly_small_freq**2) + CS%beta_dx2_u(I,j) = oneOrTwo * ((G%dxCu(I,j))**2 + (G%dyCu(I,j))**2) * (sqrt( & 0.25*( (((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2 + & ((G%CoriolisBu(I+1,J)-G%CoriolisBu(I,J)) * G%IdxCv(i+1,J))**2) + & (((G%CoriolisBu(I+1,J-1)-G%CoriolisBu(I,J-1)) * G%IdxCv(i+1,J-1))**2 + & @@ -1162,9 +1148,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%f2_dx2_v(i,J) = (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * & - max(0.5*US%s_to_T**2 * (G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq2) - CS%beta_dx2_v(i,J) = oneOrTwo * (G%dxCv(i,J)**2 + G%dyCv(i,J)**2) * (US%s_to_T * sqrt( & + CS%f2_dx2_v(i,J) = ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * & + max(0.5*(G%CoriolisBu(I,J)**2+G%CoriolisBu(I-1,J)**2), absurdly_small_freq**2) + CS%beta_dx2_v(i,J) = oneOrTwo * ((G%dxCv(i,J))**2 + (G%dyCv(i,J))**2) * (sqrt( & ((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & 0.25*( (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J+1)-G%CoriolisBu(I-1,J)) * G%IdyCu(I-1,j+1))**2) + & @@ -1186,10 +1172,10 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 do j=js-1,je+1 ; do i=is-1,ie+1 CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & - max(0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + max(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)), & - absurdly_small_freq2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (US%s_to_T * sqrt(0.5 * & + absurdly_small_freq**2) + CS%beta_dx2_h(i,j) = oneOrTwo * ((G%dxT(i,j))**2 + (G%dyT(i,j))**2) * (sqrt(0.5 * & ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & @@ -1199,7 +1185,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_cg1) then in_use = .true. - allocate(CS%cg1(isd:ied,jsd:jed)); CS%cg1(:,:) = 0.0 + allocate(CS%cg1(isd:ied,jsd:jed)) ; CS%cg1(:,:) = 0.0 call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, mono_N2_depth=N2_filter_depth) endif @@ -1224,18 +1210,19 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! register diagnostics CS%id_KH_u_QG = register_diag_field('ocean_model', 'KH_u_QG', diag%axesCuL, Time, & - 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at u-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v_QG = register_diag_field('ocean_model', 'KH_v_QG', diag%axesCvL, Time, & - 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1') + 'Horizontal viscosity from Leith QG, at v-points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) do j=Jsq,Jeq+1 ; do I=is-1,Ieq ! Static factors in the Leith schemes grid_sp_u2 = G%dyCu(I,j)*G%dxCu(I,j) - grid_sp_u3 = grid_sp_u2*sqrt(grid_sp_u2) + grid_sp_u3 = sqrt(grid_sp_u2) CS%Laplac3_const_u(I,j) = Leith_Lap_const * grid_sp_u3 enddo ; enddo do j=js-1,Jeq ; do I=Isq,Ieq+1 ! Static factors in the Leith schemes + !### The second factor here is wrong. It should be G%dxCv(i,J). grid_sp_v2 = G%dyCv(i,J)*G%dxCu(i,J) grid_sp_v3 = grid_sp_v2*sqrt(grid_sp_v2) CS%Laplac3_const_v(i,J) = Leith_Lap_const * grid_sp_v3 diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f9db6eba2b..c4a2d0c38f 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -41,16 +41,16 @@ module MOM_mixed_layer_restrat !! [nondim]. This increases with grid spacing^2, up to something !! of order 500. real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD [nondim]. - real :: front_length !< If non-zero, is the frontal-length scale [m] used to calculate the + real :: front_length !< If non-zero, is the frontal-length scale [L ~> m] used to calculate the !! upscaling of buoyancy gradients that is otherwise represented !! by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is !! non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0. logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [s]. - real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [s]. - real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kgm-3]. + real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. + real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. + real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [kg m-3]. real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer restratification !! depth used for a smoother stream function at the base of !! the mixed-layer [nondim]. @@ -94,9 +94,9 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [s] @@ -109,56 +109,56 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, "Module must be initialized before it is used.") if (GV%nkml>0) then - call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) + call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, G, GV, US, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, US%s_to_T*dt, MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt_in_T, MLD_in, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: 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_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [m] (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! 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)) :: & 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 [m s-2] + Rml_av_fast, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m 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 [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + 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 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m] (not H). - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + 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 :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] 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) [s-1] + 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_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a @@ -166,11 +166,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! the mixed layer must be 0. real :: b(SZK_(G)) ! As for a(k) but for the slow-filtered MLD real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [s], stored in 2-D arrays + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays ! for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -179,7 +179,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer densities [Pa]. real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho - real :: hAtVel, zpa, zpb, dh, res_scaling_fac, I_l_f + real :: hAtVel, zpa, zpb, dh, res_scaling_fac + real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: proper_averaging, line_is_empty, keep_going, res_upscale real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions @@ -246,8 +247,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call hchksum(CS%MLD_filtered,'mixed_layer_restrat: MLD_filtered',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(MLD_in,'mixed_layer_restrat: MLD in',G%HI,haloshift=1) endif - aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time ) + aFac = CS%MLE_MLD_decay_time / ( dt_in_T + CS%MLE_MLD_decay_time ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -263,8 +264,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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) endif - aFac = CS%MLE_MLD_decay_time2 / ( dt + CS%MLE_MLD_decay_time2 ) - bFac = dt / ( dt + CS%MLE_MLD_decay_time2 ) + aFac = CS%MLE_MLD_decay_time2 / ( dt_in_T + CS%MLE_MLD_decay_time2 ) + bFac = dt_in_T / ( dt_in_T + CS%MLE_MLD_decay_time2 ) do j = js-1, je+1 ; do i = is-1, ie+1 ! Expression bFac*MLD_fast(i,j) + aFac*CS%MLD_filtered(i,j) is the time-filtered ! (running mean) of MLD. The max() allows the "running mean" to be reset @@ -280,14 +281,14 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var uDml(:) = 0.0 ; vDml(:) = 0.0 uDml_slow(:) = 0.0 ; vDml_slow(:) = 0.0 - I4dt = 0.25 / dt + I4dt = 0.25 / (dt_in_T) g_Rho0 = GV%g_Earth / GV%Rho0 h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z proper_averaging = .not. CS%MLE_use_MLD_ave_bug if (CS%front_length>0.) then res_upscale = .true. - I_l_f = 1./CS%front_length + I_LFront = 1. / CS%front_length else res_upscale = .false. endif @@ -296,7 +297,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & +!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & !$OMP res_upscale, & !$OMP nz,MLD_fast,uDml_diag,vDml_diag,proper_averaging) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & @@ -343,10 +344,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo 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) - 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) + 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_to_m**2*US%s_to_T**2) endif ! TO DO: @@ -357,10 +359,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do I=is-1,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,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 if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -372,8 +374,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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%mask2dCu(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) + uDml(I) = timescale * G%mask2dCu(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) ! 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 mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -381,8 +383,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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%mask2dCu(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) + uDml_slow(I) = timescale * G%mask2dCu(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) if (uDml(I) + uDml_slow(I) == 0.) then do k=1,nz ; uhml(I,j,k) = 0.0 ; enddo @@ -421,7 +423,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz uhml(I,j,k) = a(k)*uDml(I) + b(k)*uDml_slow(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -433,10 +435,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do J=js-1,je ; do i=is,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + 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 if (res_upscale) res_scaling_fac = & - ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & + ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) @@ -448,8 +450,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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%mask2dCv(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) + vDml(i) = timescale * G%mask2dCv(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) ! 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 mom_mixrate = (0.41*9.8696)*u_star**2 / & @@ -457,8 +459,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var 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%mask2dCv(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) + vDml_slow(i) = timescale * G%mask2dCv(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) if (vDml(i) + vDml_slow(i) == 0.) then do k=1,nz ; vhml(i,J,k) = 0.0 ; enddo @@ -497,7 +499,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo do k=1,nz vhml(i,J,k) = a(k)*vDml(i) + b(k)*vDml_slow(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -507,11 +509,18 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + if (CS%id_uhml > 0 .or. CS%id_vhml > 0) & + ! Remapped uhml and vhml require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) + call diag_update_remap_grids(CS%diag) + ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_urestrat_time > 0) call post_data(CS%id_urestrat_time, utimescale_diag, CS%diag) @@ -547,40 +556,40 @@ end subroutine mixedlayer_restrat_general !> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. -subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) +subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt_in_T, G, GV, US, CS) 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_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H m2 s-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_avail ! The volume available for diffusion out of each face of each - ! sublayer of the mixed layer, divided by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! 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)) :: & 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 [m s-2] - real :: g_Rho0 ! G_Earth/Rho0 [m5 Z-1 s-2 kg-1 ~> m4 s-2 kg-1] + Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] + real :: g_Rho0 ! G_Earth/Rho0 [m3 L2 Z-1 T-2 kg-1 ~> m4 s-2 kg-1] real :: Rho0(SZI_(G)) ! Potential density relative to the surface [kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [Pa] real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) - real :: absf ! absolute value of f, interpolated to velocity points [s-1] - real :: u_star ! surface friction velocity, interpolated to velocity points [Z s-1 ~> m s-1]. - real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [s-1] - real :: timescale ! mixing growth timescale [s] + 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 :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: timescale ! mixing growth timescale [T ~> s] 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) + 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] real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] @@ -589,10 +598,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions [s], stored in 2-D + ! directions [T ~> s], stored in 2-D ! arrays for diagnostic purposes. real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -606,7 +615,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return uDml(:) = 0.0 ; vDml(:) = 0.0 - I4dt = 0.25 / dt + I4dt = 0.25 / (dt_in_T) g_Rho0 = GV%g_Earth / GV%Rho0 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff @@ -654,7 +663,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -663,10 +672,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) 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)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - uDml(I) = timescale * G%mask2dCu(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) + uDml(I) = timescale * G%mask2dCu(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) if (uDml(I) == 0) then do k=1,nkml ; uhml(I,j,k) = 0.0 ; enddo @@ -687,7 +696,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml uhml(I,j,k) = a(k)*uDml(I) - uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhml(I,j,k)*dt_in_T enddo endif @@ -701,7 +710,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 ! 0.41 is the von Karmen constant, 9.8696 = pi^2. @@ -710,16 +719,16 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) 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)**2/L_def**2)) +! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - vDml(i) = timescale * G%mask2dCv(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) + vDml(i) = timescale * G%mask2dCv(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) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo else I2htot = 1.0 / (htot(i,j) + htot(i,j+1) + h_neglect) z_topx2 = 0.0 - ! a(k) relates the sublayer transport to uDml with a linear profile. + ! a(k) relates the sublayer transport to vDml with a linear profile. ! The sum of a(k) through the mixed layers must be 0. do k=1,nkml hx2 = (h(i,j,k) + h(i,j+1,k) + h_neglect) @@ -733,7 +742,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo do k=1,nkml vhml(i,J,k) = a(k)*vDml(i) - vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhml(i,J,k)*dt_in_T enddo endif @@ -743,7 +752,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) enddo ; enddo ; enddo !$OMP end parallel @@ -807,12 +816,11 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, if (.not. mixedlayer_restrat_init) return if (.not.associated(CS)) then - call MOM_error(FATAL, "mixedlayer_restrat_init called without an "// & - "associated control structure.") + call MOM_error(FATAL, "mixedlayer_restrat_init called without an associated control structure.") endif ! Nonsense values to cause problems when these parameters are not used - CS%MLE_MLD_decay_time = -9.e9 + CS%MLE_MLD_decay_time = -9.e9*US%s_to_T CS%MLE_density_diff = -9.e9 CS%MLE_tail_dh = -9.e9 CS%MLE_use_PBL_MLD = .false. @@ -839,7 +847,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "upscaling of buoyancy gradients that is otherwise represented "//& "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is "//& "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& - units="m", default=0.0) + units="m", default=0.0, scale=US%m_to_L) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer "//& "depth provided by the active PBL parameterization. If false, "//& @@ -849,12 +857,12 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "The time-scale for a running-mean filter applied to the mixed-layer "//& "depth used in the MLE restratification parameterization. When "//& "the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & "The time-scale for a running-mean filter applied to the filtered "//& "mixed-layer depth used in a second MLE restratification parameterization. "//& "When the MLD deepens below the current running-mean the running-mean "//& - "is instantaneously set to the current MLD.", units="s", default=0.) + "is instantaneously set to the current MLD.", units="s", default=0., scale=US%s_to_T) if (.not. CS%MLE_use_PBL_MLD) then call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer "//& @@ -876,8 +884,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%diag => diag - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif + if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0*US%L_to_m**2*US%s_to_T + else ; flux_to_kg_per_s = US%L_to_m**2*US%s_to_T ; endif CS%id_uhml = register_diag_field('ocean_model', 'uhml', diag%axesCuL, Time, & 'Zonal Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & @@ -886,22 +894,26 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, 'Meridional Thickness Flux to Restratify Mixed Layer', 'kg s-1', conversion=flux_to_kg_per_s, & x_cell_method='sum', v_extensive=.true.) CS%id_urestrat_time = register_diag_field('ocean_model', 'MLu_restrat_time', diag%axesCu1, Time, & - 'Mixed Layer Zonal Restratification Timescale', 's') + 'Mixed Layer Zonal Restratification Timescale', 's', conversion=US%T_to_s) CS%id_vrestrat_time = register_diag_field('ocean_model', 'MLv_restrat_time', diag%axesCv1, Time, & - 'Mixed Layer Meridional Restratification Timescale', 's') + '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') 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 s2', conversion=US%m_to_Z) + 'm s2', conversion=US%m_to_Z*US%L_to_m**2*US%s_to_T**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') + '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) CS%id_vDml = register_diag_field('ocean_model', 'vdml_restrat', diag%axesCv1, Time, & - 'Transport stream function amplitude for meridional restratification of mixed layer', 'm3 s-1') + 'Transport stream function amplitude for meridional restratification of mixed layer', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_uml = register_diag_field('ocean_model', 'uml_restrat', diag%axesCu1, Time, & - 'Surface zonal velocity component of mixed layer restratification', 'm s-1') + 'Surface zonal velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) CS%id_vml = register_diag_field('ocean_model', 'vml_restrat', diag%axesCv1, Time, & - 'Surface meridional velocity component of mixed layer restratification', 'm s-1') + 'Surface meridional velocity component of mixed layer restratification', & + 'm s-1', conversion=US%L_T_to_m_s) ! Rescale variables from restart files if the internal dimensional scalings have changed. if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 9a5cfede6f..d639a986bf 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -13,6 +13,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_interface_heights, only : find_eta +use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_unit_scaling, only : unit_scale_type @@ -24,7 +25,8 @@ module MOM_thickness_diffuse #include public thickness_diffuse, thickness_diffuse_init, thickness_diffuse_end -public vert_fill_TS, thickness_diffuse_get_KH +! public vert_fill_TS +public thickness_diffuse_get_KH ! 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 @@ -33,14 +35,14 @@ module MOM_thickness_diffuse !> Control structure for thickness diffusion type, public :: thickness_diffuse_CS ; private - real :: Khth !< Background interface depth diffusivity [m2 s-1] + real :: Khth !< Background interface depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [m2 s-1] real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion - real :: Khth_Min !< Minimum value of Khth [m2 s-1] - real :: Khth_Max !< Maximum value of Khth [m2 s-1], or 0 for no max + real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] + real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max real :: slope_max !< Slopes steeper than slope_max are limited in some way [nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers [Z2 s-1 ~> m2 s-1]. + !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 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 @@ -50,12 +52,12 @@ module MOM_thickness_diffuse real :: FGNV_c_min !< A minimum wave speed used in the Ferrari et al., 2010, !! streamfunction formulation [m s-1]. real :: N2_floor !< A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010, - !! streamfunction formulation [s-2]. + !! streamfunction formulation [T-2 ~> s-2]. logical :: detangle_interfaces !< If true, add 3-d structured interface height !! diffusivities to horizontally smooth jagged layers. real :: detangle_time !< If detangle_interfaces is true, this is the !! timescale over which maximally jagged grid-scale - !! thickness variations are suppressed [s]. This must be + !! thickness variations are suppressed [T ~> s]. This must be !! longer than DT, or 0 (the default) to use DT. integer :: nkml !< number of layers within mixed layer logical :: debug !< write verbose checksums for debugging purposes @@ -66,7 +68,7 @@ module MOM_thickness_diffuse real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of !! the GEOMETRIC thickness difussion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness - !! diffusivity [s-1]. + !! diffusivity [T-1 ~> s-1]. logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. @@ -76,8 +78,8 @@ module MOM_thickness_diffuse real, pointer :: diagSlopeY(:,:,:) => NULL() !< Diagnostic: zonal neutral slope [nondim] real, dimension(:,:,:), pointer :: & - KH_u_GME => NULL(), & !< interface height diffusivities in u-columns (m2 s-1) - KH_v_GME => NULL() !< interface height diffusivities in v-columns (m2 s-1) + KH_u_GME => NULL(), & !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_v_GME => NULL() !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -100,9 +102,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux - !! [m2 H ~> m3 or kg] + !! [L2 H ~> m3 or kg] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [s] type(MEKE_type), pointer :: MEKE !< MEKE control structure @@ -112,40 +114,41 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Local variables real :: e(SZI_(G), SZJ_(G), SZK_(G)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. - real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] - real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [m2 H s-1 ~> m3 s-1 or kg s-1] + real :: uhD(SZIB_(G), SZJ_(G), SZK_(G)) ! Diffusive u*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] + real :: vhD(SZI_(G), SZJB_(G), SZK_(G)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & - KH_u, & ! interface height diffusivities in u-columns [m2 s-1] + KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: & - KH_v, & ! interface height diffusivities in v-columns [m2 s-1] + KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - KH_t ! diagnosed diffusivity at tracer points [m2 s-1] + KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G), SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [m2 s-1] + KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G), SZJB_(G)) :: & - KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [m2 s-1] + KH_v_CFL ! The maximum stable interface height diffusivity at v grid points [L2 T-1 ~> m2 s-1] real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) - real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [m2 s-1] + real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 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, dimension(:,:), pointer :: cg1 => null() !< Wave speed [m s-1] + real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] + real :: dt_in_T ! Time increment [T ~> s] logical :: use_VarMix, Resoln_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz real :: hu(SZI_(G), SZJ_(G)) ! u-thickness [H ~> m or kg m-2] real :: hv(SZI_(G), SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] - real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [m2 s-1] + real :: KH_u_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] + real :: KH_v_lay(SZI_(G), SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] if (.not. associated(CS)) call MOM_error(FATAL, "MOM_thickness_diffuse:"// & "Module must be initialized before it is used.") @@ -155,6 +158,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke h_neglect = GV%H_subroundoff + dt_in_T = US%s_to_T*dt if (associated(MEKE)) then if (associated(MEKE%GM_src)) then @@ -181,12 +185,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,KH_u_CFL,dt,G,CS) do j=js,je ; do I=is-1,ie KH_u_CFL(I,j) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) + (dt_in_T * (G%IdxCu(I,j)*G%IdxCu(I,j) + G%IdyCu(I,j)*G%IdyCu(I,j))) enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,KH_v_CFL,dt,G,CS) do j=js-1,je ; do I=is,ie KH_v_CFL(i,J) = (0.25*CS%max_Khth_CFL) / & - (dt*(G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) + (dt_in_T * (G%IdxCv(i,J)*G%IdxCv(i,J) + G%IdyCv(i,J)*G%IdyCv(i,J))) enddo ; enddo ! Calculates interface heights, e, in [Z ~> m]. @@ -199,14 +203,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP int_slope_v,khth_use_ebt_struct) !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = CS%Khth + Khth_loc_u(I,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + CS%KHTH_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + & + CS%KHTH_Slope_Cff*VarMix%L2u(I,j) * VarMix%SN_u(I,j) enddo ; enddo endif endif @@ -215,13 +220,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + & - G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & + Khth_loc_u(I,j) = Khth_loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & + 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do j=js,je ; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Khth_loc_u(I,j) = Khth_loc_u(I,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) enddo ; enddo endif endif ; endif @@ -229,24 +234,24 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = Khth_Loc_u(I,j) * VarMix%Res_fn_u(I,j) + Khth_loc_u(I,j) = Khth_loc_u(I,j) * VarMix%Res_fn_u(I,j) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, min(Khth_Loc_u(I,j),CS%Khth_Max)) + Khth_loc_u(I,j) = max(CS%Khth_Min, min(Khth_loc_u(I,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do j=js,je; do I=is-1,ie - Khth_Loc_u(I,j) = max(CS%Khth_min, Khth_Loc_u(I,j)) + Khth_loc_u(I,j) = max(CS%Khth_Min, Khth_loc_u(I,j)) enddo ; enddo endif !$OMP do do j=js,je; do I=is-1,ie - KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_Loc_u(I,j)) + KH_u(I,j,1) = min(KH_u_CFL(I,j), Khth_loc_u(I,j)) enddo ; enddo if (khth_use_ebt_struct) then @@ -273,20 +278,20 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then do k=1,nz+1 ; do j=js,je ; do I=is-1,ie - CS%KH_u_GME(I,j,k) = KH_u(I,j,k) + CS%KH_u_GME(I,j,k) = KH_u(I,j,k) enddo ; enddo ; enddo endif !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = CS%Khth + Khth_loc(i,j) = CS%Khth enddo ; enddo if (use_VarMix) then !$OMP do if (use_Visbeck) then do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) + CS%KHTH_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) enddo ; enddo endif endif @@ -294,13 +299,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js-1,je ; do I=is,ie - Khth_Loc(I,j) = Khth_Loc(I,j) + & - G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & + Khth_loc(I,j) = Khth_loc(I,j) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & + 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo else do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Khth_loc(i,j) = Khth_loc(i,j) + MEKE%KhTh_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) enddo ; enddo endif endif ; endif @@ -308,26 +313,26 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (Resoln_scaled) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = Khth_Loc(i,j) * VarMix%Res_fn_v(i,J) + Khth_loc(i,j) = Khth_loc(i,j) * VarMix%Res_fn_v(i,J) enddo ; enddo endif if (CS%Khth_Max > 0) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, min(Khth_Loc(i,j),CS%Khth_Max)) + Khth_loc(i,j) = max(CS%Khth_Min, min(Khth_loc(i,j), CS%Khth_Max)) enddo ; enddo else !$OMP do do J=js-1,je ; do i=is,ie - Khth_Loc(i,j) = max(CS%Khth_min, Khth_Loc(i,j)) + Khth_loc(i,j) = max(CS%Khth_Min, Khth_loc(i,j)) enddo ; enddo endif if (CS%max_Khth_CFL > 0.0) then !$OMP do do J=js-1,je ; do i=is,ie - KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_Loc(i,j)) + KH_v(i,J,1) = min(KH_v_CFL(i,J), Khth_loc(i,j)) enddo ; enddo endif @@ -354,8 +359,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%use_GME_thickness_diffuse) then - do k=1,nz+1 ; do j=js-1,je ; do I=is,ie - CS%KH_v_GME(I,j,k) = KH_v(I,j,k) + do k=1,nz+1 ; do J=js-1,je ; do i=is,ie + CS%KH_v_GME(i,J,k) = KH_v(i,J,k) enddo ; enddo ; enddo endif @@ -363,6 +368,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP do if (CS%MEKE_GEOMETRIC) then do j=js,je ; do I=is,ie + !### This will not give bitwise rotational symmetry. Add parentheses. MEKE%Kh(i,j) = CS%MEKE_GEOMETRIC_alpha * MEKE%MEKE(i,j) / & (0.25*(VarMix%SN_u(I,j)+VarMix%SN_u(I-1,j)+VarMix%SN_v(i,J)+VarMix%SN_v(i,J-1)) + & CS%MEKE_GEOMETRIC_epsilon) @@ -378,12 +384,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP end parallel if (CS%detangle_interfaces) then - call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, & + call add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, & CS, int_slope_u, int_slope_v) endif if (CS%debug) then - call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI,haloshift=0) + call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI, haloshift=0, scale=US%L_to_m**2*US%s_to_T) 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) @@ -399,10 +405,10 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Calculate uhD, vhD from h, e, KH_u, KH_v, tv%T/S if (use_stored_slopes) then - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v, VarMix%slope_x, VarMix%slope_y) else - call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, CS, & + call thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, CS, & int_slope_u, int_slope_v) endif @@ -446,7 +452,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ! diagnose diffusivity at T-point do j=js,je ; do i=is,ie - KH_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & + Kh_t(i,j,k) = ((hu(I-1,j)*KH_u_lay(i-1,j)+hu(I,j)*KH_u_lay(I,j)) & +(hv(i,J-1)*KH_v_lay(i,J-1)+hv(i,J)*KH_v_lay(i,J))) & / (hu(I-1,j)+hu(I,j)+hv(i,J-1)+hv(i,J)+h_neglect) enddo ; enddo @@ -456,7 +462,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp MEKE%Kh_diff(:,:) = 0.0 do k=1,nz do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + KH_t(i,j,k) * h(i,j,k) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) + Kh_t(i,j,k) * h(i,j,k) enddo; enddo enddo @@ -474,15 +480,15 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp !$OMP parallel do default(none) shared(is,ie,js,je,nz,uhtr,uhD,dt,vhtr,CDp,vhD,h,G,GV) do k=1,nz do j=js,je ; do I=is-1,ie - uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k)*dt + uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) * dt_in_T if (associated(CDp%uhGM)) CDp%uhGM(I,j,k) = uhD(I,j,k) enddo ; enddo do J=js-1,je ; do i=is,ie - vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k)*dt + vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) * dt_in_T if (associated(CDp%vhGM)) CDp%vhGM(i,J,k) = vhD(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - h(i,j,k) = h(i,j,k) - dt * G%IareaT(i,j) * & + h(i,j,k) = h(i,j,k) - dt_in_T * G%IareaT(i,j) * & ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H enddo ; enddo @@ -495,9 +501,9 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%debug) then call uvchksum("thickness_diffuse [uv]hD", uhD, vhD, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) call uvchksum("thickness_diffuse [uv]htr", uhtr, vhtr, & - G%HI, haloshift=0, scale=GV%H_to_m) + G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) call hchksum(h, "thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -506,7 +512,7 @@ end subroutine thickness_diffuse !> Calculates parameterized layer transports for use in the continuity equation. !! Fluxes are limited to give positive definite thicknesses. !! Called by thickness_diffuse(). -subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV, US, MEKE, & +subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt_in_T, G, GV, US, MEKE, & CS, int_slope_u, int_slope_v, slope_x, slope_y) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -514,16 +520,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces !! at v points [m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uhD !< Zonal mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vhD !< Meridional mass fluxes - !! [H m2 s-1 ~> m3 s-1 or kg s-1] - real, dimension(:,:), pointer :: cg1 !< Wave speed [m s-1] - real, intent(in) :: dt !< Time increment [s] + !! [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(MEKE_type), pointer :: MEKE !< MEKE control structure type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), optional, intent(in) :: int_slope_u !< Ratio that determine how much of @@ -545,28 +551,28 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV Rho, & ! Density itself [kg m-3], when a nonlinear equation of state is ! not in use. h_avail, & ! The mass available for diffusion out of each face, divided - ! by dt [H m2 s-1 ~> m3 s-1 or kg s-1]. + ! 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 s-2], ! used for calculating PE release real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: & Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below, nondim) - hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [m s-2] + hN2_x_PE ! thickness in m times Brunt-Vaisala freqeuncy at u-points [L2 Z-1 T-2 ~> m s-2], ! used for calculating PE release real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: & pres, & ! The pressure at an interface [Pa]. - h_avail_rsum ! The running sum of h_avail above an interface [H m2 s-1 ~> m3 s-1 or kg s-1]. + h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [kg m-3 degC-1] drho_dS_u ! The derivative of density with salinity at u points [kg m-3 ppt-1]. real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [kg m-3 degC-1] drho_dS_v ! The derivative of density with salinity at v points [kg m-3 ppt-1]. - real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H m2 s-1 ~> m3 s-1 or kg s-1]. - real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H m2 s-1 ~> m3 s-1 or kg s-1]. + real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)) :: & T_u, & ! Temperature on the interface at the u-point [degC]. S_u, & ! Salinity on the interface at the u-point [ppt]. @@ -578,9 +584,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [W]. real :: Work_h ! The work averaged over an h-cell [W m-2]. - real :: PE_release_h ! The amount of potential energy released by GM, averaged over an h-cell [m3 s-3]. + 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 :: I4dt ! 1 / 4 dt [s-1]. + real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the ! interface times the grid spacing [kg m-3]. @@ -595,26 +601,26 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m]. real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. - real :: drdx, drdy ! Zonal and meridional density gradients [kg m-4]. + real :: drdx, drdy ! Zonal and meridional density gradients [kg m-3 L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [kg m-3 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_(G)+1) ! Wave speed squared divided by h at u-points [m2 Z-1 s-2 ~> m s-2]. - real :: c2_h_v(SZI_(G), SZK_(G)+1) ! Wave speed squared divided by h at v-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_u(SZIB_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above u-points [m2 Z-1 s-2 ~> m s-2]. - real :: hN2_v(SZI_(G), SZK_(G)+1) ! Thickness in m times N2 at interfaces above v-points [m2 Z-1 s-2 ~> m s-2]. + real :: c2_h_u(SZIB_(G), SZK_(G)+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_(G)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. + real :: hN2_u(SZIB_(G), SZK_(G)+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_(G)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning - ! streamfunction [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z m2 s-1 ~> m3 s-1]. - real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z m2 s-1 ~> m3 s-1]. + ! streamfunction [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_u(SZIB_(G), SZK_(G)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_unlim_v(SZI_(G), SZK_(G)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. real :: slope2_Ratio_u(SZIB_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. real :: slope2_Ratio_v(SZI_(G), SZK_(G)+1) ! The ratio of the slope squared to slope_max squared. - real :: Sfn_in_h ! The overturning streamfunction [H m2 s-1 ~> m3 s-1 or kg s-1] (note that + 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 m2 s-1 ~> m3 s-1]. + ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1]. real :: Slope ! The slope of density surfaces, calculated in a way ! that is always between -1 and 1, nondimensional. - real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-8]. + real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [kg2 m-6 L-2 ~> kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared, nondimensional. 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]. @@ -622,14 +628,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. real :: G_scale ! The gravitational acceleration times some unit conversion - ! factors [m3 Z-1 H-1 s-2 ~> m s-2 or m4 kg-1 s-2]. + ! factors [m3 T Z-1 H-1 s-3 ~> 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 [m5 Z-1 s-2 ~> m4 s-2]. + real :: G_rho0 ! g/Rho0 [L2 m3 Z-1 T-2 ~> m4 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors [s-2 m2 Z-2 ~> s-2] + ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] real, dimension(SZIB_(G), SZJ_(G), SZK_(G)+1) :: diag_sfn_x, diag_sfn_unlim_x ! Diagnostics real, dimension(SZI_(G), SZJB_(G), SZK_(G)+1) :: diag_sfn_y, diag_sfn_unlim_y ! Diagnostics logical :: present_int_slope_u, present_int_slope_v @@ -638,13 +644,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV integer :: i, j, k is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke ; IsdB = G%IsdB - I4dt = 0.25 / dt + I4dt = 0.25 / (dt_in_T) I_slope_max2 = 1.0 / (CS%slope_max**2) - G_scale = GV%g_Earth * GV%H_to_m + G_scale = GV%g_Earth*US%L_to_m**2*US%s_to_T**3 * GV%H_to_m h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 dz_neglect = GV%H_subroundoff*GV%H_to_Z G_rho0 = GV%g_Earth / GV%Rho0 - N2_floor = CS%N2_floor*US%Z_to_m**2 + N2_floor = CS%N2_floor*US%Z_to_L**2 use_EOS = associated(tv%eqn_of_state) present_int_slope_u = PRESENT(int_slope_u) @@ -664,7 +670,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV find_work = (associated(CS%GMwork) .or. find_work) if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth, dt, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt_in_T, T, S, G, GV, 1, larger_h_denom=.true.) endif if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & @@ -806,7 +812,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdx**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdx**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdx / sqrt(mag_grad2) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -820,16 +826,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_u) then Slope = (1.0 - int_slope_u(I,j,K)) * Slope + & - int_slope_u(I,j,K) * US%Z_to_m*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) + int_slope_u(I,j,K) * US%Z_to_L*((e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j)) slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) endif Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) - hN2_x_PE(I,j,k) = hN2_u(I,K) * US%m_to_Z + 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 [m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -855,10 +861,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = US%Z_to_L*((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) 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))*US%m_to_Z*Slope) + Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*US%L_to_Z*Slope) hN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -873,7 +879,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(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) + c2_h_u(I,k) = CS%FGNV_scale * & + ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -907,11 +914,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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 * GV%Z_to_H, -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. - uhD(I,j,k) = max(min((Sfn_in_h - uhtot(I,j)), h_avail(i,j,k)), & + uhD(I,j,k) = max(min((Sfn_in_H - uhtot(I,j)), h_avail(i,j,k)), & -h_avail(i+1,j,k)) if (CS%id_sfn_x>0) diag_sfn_x(I,j,K) = diag_sfn_x(I,j,K+1) + uhD(I,j,k) @@ -1055,7 +1062,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = drdy**2 + (US%m_to_Z*drdz)**2 + mag_grad2 = drdy**2 + (US%L_to_Z*drdz)**2 if (mag_grad2 > 0.0) then Slope = drdy / sqrt(mag_grad2) slope2_Ratio_v(i,K) = Slope**2 * I_slope_max2 @@ -1069,16 +1076,16 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! that ignore density gradients along layers. if (present_int_slope_v) then Slope = (1.0 - int_slope_v(i,J,K)) * Slope + & - int_slope_v(i,J,K) * US%Z_to_m*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) + int_slope_v(i,J,K) * US%Z_to_L*((e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J)) slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) endif Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) - hN2_y_PE(i,J,k) = hN2_v(i,K) * US%m_to_Z + 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 [m3 s-1]. - Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -1104,10 +1111,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = US%Z_to_m*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = US%Z_to_L*((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) 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))*US%m_to_Z*Slope) + Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*US%L_to_Z*Slope) hN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) @@ -1122,7 +1129,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do k=1,nz ; do i=is,ie ; if (G%mask2dCv(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) + c2_h_v(i,k) = CS%FGNV_scale * & + ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1156,12 +1164,11 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! 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 * GV%Z_to_H, -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. - vhD(i,J,k) = max(min((Sfn_in_h - vhtot(i,J)), h_avail(i,j,k)), & - -h_avail(i,j+1,k)) + vhD(i,J,k) = max(min((Sfn_in_H - vhtot(i,J)), h_avail(i,j,k)), -h_avail(i,j+1,k)) if (CS%id_sfn_y>0) diag_sfn_y(i,J,K) = diag_sfn_y(i,J,K+1) + vhD(i,J,k) ! sfn_y(i,J,K) = max(min(Sfn_in_h, vhtot(i,J)+h_avail(i,j,k)), & @@ -1269,7 +1276,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) if (associated(CS%GMwork)) CS%GMwork(i,j) = Work_h if (associated(MEKE) .and. associated(MEKE%GM_src) .and. .not. CS%GM_src_alt ) then - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + Work_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%m_to_L**2*US%T_to_s**3* Work_h endif enddo ; enddo @@ -1279,7 +1286,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV 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) + PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_m**2*US%m_to_Z*PE_release_h enddo ; enddo ; enddo endif endif @@ -1298,7 +1305,7 @@ 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 [m s-2] real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [m s-2] - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z m2 s-1 ~> m3 s-1] or arbitrary units + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z L2 T-1 ~> m3 s-1] or arbitrary units !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables @@ -1327,7 +1334,7 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver !> Modifies thickness diffusivities to untangle layer structures -subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & +subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt_in_T, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -1335,15 +1342,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface positions [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [m2 s-1] + !! at u points [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity - !! at v points [m2 s-1] + !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, intent(in) :: dt !< Time increment [s] + real, intent(in) :: dt_in_T !< Time increment [T ~> s] type(thickness_diffuse_CS), pointer :: CS !< Control structure for thickness diffusion real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from @@ -1359,10 +1366,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & Kh_lay_u ! The tentative interface height diffusivity for each layer at - ! u points [m2 s-1]. + ! u points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & Kh_lay_v ! The tentative interface height diffusivity for each layer at - ! v points [m2 s-1]. + ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the ! detangling is applied [H ~> m or kg m-2]. @@ -1375,44 +1382,44 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! normalized by the arithmetic mean thickness. real :: Kh_scale ! A ratio by which Kh_u_CFL is scaled for maximally jagged ! layers [nondim]. - real :: Kh_det ! The detangling diffusivity [m2 s-1]. +! real :: Kh_det ! The detangling diffusivity [m2 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 :: I_sl ! The absolute value of the larger in magnitude of the slopes - ! above and below. + ! above and below [L Z-1 ~> nondim]. real :: Rsl ! The ratio of the smaller magnitude slope to the larger ! magnitude one [nondim]. 0 <= Rsl <1. real :: IRsl ! The (limited) inverse of Rsl [nondim]. 1 < IRsl <= 1e9. real :: dH ! The thickness gradient divided by the damping timescale ! and the ratio of the face length to the adjacent cell - ! areas for comparability with the diffusivities [m2 s-1]. - real :: adH ! The absolute value of dH [m2 s-1]. + ! areas for comparability with the diffusivities [L Z T-1 ~> m2 s-1]. + real :: adH ! The absolute value of dH [L Z T-1 ~> m2 s-1]. real :: sign ! 1 or -1, with the same sign as the layer thickness gradient. - real :: sl_K ! The sign-corrected slope of the interface above [nondim]. - real :: sl_Kp1 ! The sign-corrected slope of the interface below [nondim]. - real :: I_sl_K ! The (limited) inverse of sl_K [nondim]. - real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [nondim]. - real :: I_4t ! A quarter of a unit conversion factor divided by - ! the damping timescale [s-1]. + real :: sl_K ! The sign-corrected slope of the interface above [Z L-1 ~> nondim]. + real :: sl_Kp1 ! The sign-corrected slope of the interface below [Z L-1 ~> nondim]. + real :: I_sl_K ! The (limited) inverse of sl_K [L Z-1 ~> nondim]. + real :: I_sl_Kp1 ! The (limited) inverse of sl_Kp1 [L Z-1 ~> nondim]. + real :: I_4t ! A quarter of a flux scaling factor divided by + ! the damping timescale [T-1 ~> s-1]. real :: Fn_R ! A function of Rsl, such that Rsl < Fn_R < 1. real :: denom, I_denom ! A denominator and its inverse, various units. - real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. - real :: Kh_max ! A local ceiling on the diffusivity [m2 s-1]. + ! real :: Kh_min ! A local floor on the diffusivity [m2 s-1]. + real :: Kh_max ! A local ceiling on the diffusivity [L2 T-1 ~> m2 s-1]. real :: wt1, wt2 ! Nondimensional weights. ! Variables used only in testing code. ! real, dimension(SZK_(G)) :: uh_here ! real, dimension(SZK_(G)+1) :: Sfn - real :: dKh ! An increment in the diffusivity [m2 s-1]. + real :: dKh ! An increment in the diffusivity [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - Kh_bg, & ! The background (floor) value of Kh [m2 s-1]. - Kh, & ! The tentative value of Kh [m2 s-1]. - Kh_detangle, & ! The detangling diffusivity that could be used [m2 s-1]. + Kh_bg, & ! The background (floor) value of Kh [L2 T-1 ~> m2 s-1]. + Kh, & ! The tentative value of Kh [L2 T-1 ~> m2 s-1]. + Kh_detangle, & ! The detangling diffusivity that could be used [L2 T-1 ~> m2 s-1]. Kh_min_max_p, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K+1) [m2 s-1]. + ! based on the value of Kh(I,K+1) [L2 T-1 ~> m2 s-1]. Kh_min_max_m, & ! The smallest ceiling that can be placed on Kh(I,K) - ! based on the value of Kh(I,K-1) [m2 s-1]. + ! based on the value of Kh(I,K-1) [L2 T-1 ~> m2 s-1]. ! The following are variables that define the relationships between ! successive values of Kh. ! Search for Kh that satisfy... @@ -1421,15 +1428,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Kh(I,K) <= Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K) ! Kh(I,K) <= Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K) Kh_min_m , & ! See above [nondim]. - Kh0_min_m , & ! See above [m2 s-1]. + Kh0_min_m , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_m , & ! See above [nondim]. - Kh0_max_m, & ! See above [m2 s-1]. + Kh0_max_m, & ! See above [L2 T-1 ~> m2 s-1]. Kh_min_p , & ! See above [nondim]. - Kh0_min_p , & ! See above [m2 s-1]. + Kh0_min_p , & ! See above [L2 T-1 ~> m2 s-1]. Kh_max_p , & ! See above [nondim]. - Kh0_max_p ! See above [m2 s-1]. + Kh0_max_p ! See above [L2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G)) :: & - Kh_max_max ! The maximum diffusivity permitted in a column. + Kh_max_max ! The maximum diffusivity permitted in a column [L2 T-1 ~> m2 s-1].. logical, dimension(SZIB_(G)) :: & do_i ! If true, work on a column. integer :: i, j, k, n, ish, jsh, is, ie, js, je, nz, k_top @@ -1441,7 +1448,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! distributing the diffusivities more effectively (with wt1 & wt2), but this ! means that the additions to a single interface can be up to twice as large. Kh_scale = 0.5 - if (CS%detangle_time > dt) Kh_scale = 0.5 * dt / CS%detangle_time + if (CS%detangle_time > dt_in_T) Kh_scale = 0.5 * dt_in_T / CS%detangle_time do j=js-1,je+1 ; do i=is-1,ie+1 de_top(i,j,k_top) = 0.0 ; de_bot(i,j) = 0.0 @@ -1472,7 +1479,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_u(I,j,k) = (Kh_scale * Kh_u_CFL(I,j)) * jag_Rat**2 + KH_lay_u(I,j,k) = (Kh_scale * KH_u_CFL(I,j)) * jag_Rat**2 endif ; enddo ; enddo do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then @@ -1484,13 +1491,13 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV h1 = max( h(i,j,k), h2 - min(de_bot(i,j), de_top(i,j,k)) ) endif jag_Rat = (h2 - h1)**2 / (h2 + h1 + h_neglect)**2 - Kh_lay_v(i,J,k) = (Kh_scale * Kh_v_CFL(i,J)) * jag_Rat**2 + KH_lay_v(i,J,k) = (Kh_scale * KH_v_CFL(i,J)) * jag_Rat**2 endif ; enddo ; enddo enddo ! Limit the diffusivities - I_4t = US%Z_to_m*Kh_scale / (4.0*dt) + I_4t = Kh_scale / (4.0 * dt_in_T) do n=1,2 if (n==1) then ; jsh = js ; ish = is-1 @@ -1502,19 +1509,19 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (n==1) then ! This is a u-column. do i=ish,ie do_i(I) = (G%mask2dCu(I,j) > 0.0) - Kh_max_max(I) = Kh_u_CFL(I,j) + Kh_Max_max(I) = KH_u_CFL(I,j) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_u(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo else ! This is a v-column. do i=ish,ie - do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_max_max(I) = Kh_v_CFL(i,J) + do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_Max_max(I) = KH_v_CFL(i,J) enddo do K=1,nz+1 ; do i=ish,ie - Kh_bg(I,K) = Kh_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) + Kh_bg(I,K) = KH_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) Kh_min_max_p(I,K) = Kh_bg(I,K) ; Kh_min_max_m(I,K) = Kh_bg(I,K) Kh_detangle(I,K) = 0.0 enddo ; enddo @@ -1524,7 +1531,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do k=k_top,nz ; do i=ish,ie ; if (do_i(i)) then if (n==1) then ! This is a u-column. dH = 0.0 - denom = ((G%IareaT(i+1,j) + G%IareaT(i,j))*G%dy_Cu(I,j)) + denom = ((G%IareaT(i+1,j) + G%IareaT(i,j)) * G%dy_Cu(I,j)) ! This expression uses differences in e in place of h for better ! consistency with the slopes. if (denom > 0.0) & @@ -1533,7 +1540,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! dH = I_4t * (h(i+1,j,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m + sign = 1.0 ; if (dH < 0) sign = -1.0 sl_K = sign * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) sl_Kp1 = sign * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) @@ -1545,18 +1552,18 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_u(I,j,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_u(I,j,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_u(I,j,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_u(I,j,k) else ! This is a v-column. dH = 0.0 - denom = ((G%IareaT(i,j+1) + G%IareaT(i,j))*G%dx_Cv(I,j)) + denom = ((G%IareaT(i,j+1) + G%IareaT(i,j)) * G%dx_Cv(I,j)) if (denom > 0.0) & dH = I_4t * ((e(i,j+1,K) - e(i,j+1,K+1)) - & (e(i,j,K) - e(i,j,K+1))) / denom ! dH = I_4t * (h(i,j+1,k) - h(i,j,k)) / denom adH = abs(dH) - sign = 1.0*US%Z_to_m ; if (dH < 0) sign = -1.0*US%Z_to_m + sign = 1.0 ; if (dH < 0) sign = -1.0 sl_K = sign * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) sl_Kp1 = sign * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) @@ -1568,8 +1575,8 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (denom > 0.0) then wt1 = sl_K**2 / denom ; wt2 = sl_Kp1**2 / denom endif - Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*Kh_lay_v(i,J,k) - Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*Kh_lay_v(i,J,k) + Kh_detangle(I,K) = Kh_detangle(I,K) + wt1*KH_lay_v(i,J,k) + Kh_detangle(I,K+1) = Kh_detangle(I,K+1) + wt2*KH_lay_v(i,J,k) endif if (adH == 0.0) then @@ -1592,15 +1599,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / (Kh_Max_max(I))) Kh_min_m(I,K+1) = Fn_R ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = Rsl ; Kh0_max_m(I,K+1) = adH * I_sl Kh_min_p(I,K) = IRsl ; Kh0_min_p(I,K) = -adH * (I_sl*IRsl) Kh_max_p(I,K) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_p(I,K) = 0.0 elseif (sl_Kp1 < 0.0) then ! Opposite (nonzero) signs of slopes. - I_sl_K = 1e18 ; if (sl_K > 1e-18) I_sl_K = 1.0 / sl_K - I_sl_Kp1 = 1e18 ; if (-sl_Kp1 > 1e-18) I_sl_Kp1 = -1.0 / sl_Kp1 + I_sl_K = 1e18*US%Z_to_L ; if (sl_K > 1e-18*US%L_to_Z) I_sl_K = 1.0 / sl_K + I_sl_Kp1 = 1e18*US%Z_to_L ; if (-sl_Kp1 > 1e-18*US%L_to_Z) I_sl_Kp1 = -1.0 / sl_Kp1 Kh_min_m(I,K+1) = 0.0 ; Kh0_min_m(I,K+1) = 0.0 Kh_max_m(I,K+1) = - sl_K*I_sl_Kp1 ; Kh0_max_m(I,K+1) = adH*I_sl_Kp1 @@ -1609,9 +1616,9 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! This limit does not use the slope weighting so that potentially ! sharp gradients in diffusivities are not forced to occur. - Kh_max = adH / (sl_K - sl_Kp1) - Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_max) - Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_max) + Kh_Max = adH / (sl_K - sl_Kp1) + Kh_min_max_p(I,K) = max(Kh_min_max_p(I,K), Kh_Max) + Kh_min_max_m(I,K+1) = max(Kh_min_max_m(I,K+1), Kh_Max) else ! Both slopes are of the same sign as dH. I_sl = 1.0 / sl_K Rsl = sl_Kp1 * I_sl ! 0 <= Rsl < 1 @@ -1620,7 +1627,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Rsl <= Fn_R <= 1 Fn_R = Rsl if (Kh_max_max(I) > 0) & - Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_max_max(I)) + Fn_R = min(sqrt(Rsl), Rsl + (adH * I_sl) / Kh_Max_max(I)) Kh_min_m(I,K+1) = IRsl ; Kh0_min_m(I,K+1) = -adH * (I_sl*IRsl) Kh_max_m(I,K+1) = 1.0/(Fn_R + 1.0e-30) ; Kh0_max_m(I,K+1) = 0.0 @@ -1659,16 +1666,16 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV do K=nz,k_top+1,-1 ; do i=ish,ie ; if (do_i(i)) then Kh(I,k) = max(Kh(I,K), min(Kh_min_p(I,K)*Kh(I,K+1) + Kh0_min_p(I,K), Kh(I,K+1))) - Kh_max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) - Kh(I,k) = min(Kh(I,k), Kh_max) + Kh_Max = max(Kh_min_max_p(I,K), Kh_max_p(I,K)*Kh(I,K+1) + Kh0_max_p(I,K)) + Kh(I,k) = min(Kh(I,k), Kh_Max) endif ; enddo ; enddo ! I-loop & k-loop ! All non-zero min constraints on one diffusivity are max constraints on ! another layer, so the min constraints can now be discounted. ! Decrease the diffusivities to satisfy the max constraints. do K=k_top+1,nz ; do i=ish,ie ; if (do_i(i)) then - Kh_max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) - if (Kh(I,k) > Kh_max) Kh(I,k) = Kh_Max + Kh_Max = max(Kh_min_max_m(I,K), Kh_max_m(I,K)*Kh(I,K-1) + Kh0_max_m(I,K)) + if (Kh(I,k) > Kh_Max) Kh(I,k) = Kh_Max endif ; enddo ; enddo ! i- and K-loops ! This code tests the solutions... @@ -1682,17 +1689,15 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i+1,j,K)-e(i,j,K)) * G%IdxCu(I,j) ! Sfn(K+1) = -Kh(i,K+1) * (e(i+1,j,K+1)-e(i,j,K+1)) * G%IdxCu(I,j) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dy_Cu(I,j) -! if (abs(uh_here(k))*min(G%IareaT(i,j), G%IareaT(i+1,j)) > & +! if (abs(uh_here(k)) * min(G%IareaT(i,j), G%IareaT(i+1,j)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(k) * (h(i+1,j,k) - h(i,j,k)) > 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is up the thickness gradient.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is up the thickness gradient.", .true.) ! endif ! if (((h(i,j,k) - 4.0*dt*G%IareaT(i,j)*uh_here(k)) - & ! (h(i+1,j,k) + 4.0*dt*G%IareaT(i+1,j)*uh_here(k))) * & ! (h(i,j,k) - h(i+1,j,k)) < 0.0) then -! call MOM_error(WARNING, & -! "Corrective u-transport is too large.", .true.) +! call MOM_error(WARNING, "Corrective u-transport is too large.", .true.) ! endif ! endif ! endif @@ -1702,7 +1707,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! Sfn(K) = -Kh(i,K) * (e(i,j+1,K)-e(i,j,K)) * G%IdyCv(i,J) ! Sfn(K+1) = -Kh(i,K+1) * (e(i,j+1,K+1)-e(i,j,K+1)) * G%IdyCv(i,J) ! uh_here(k) = (Sfn(K) - Sfn(K+1))*G%dx_Cv(i,J) -! if (abs(uh_here(K))*min(G%IareaT(i,j), G%IareaT(i,j+1)) > & +! if (abs(uh_here(K)) * min(G%IareaT(i,j), G%IareaT(i,j+1)) > & ! (1e-10*GV%m_to_H)) then ! if (uh_here(K) * (h(i,j+1,k) - h(i,j,k)) > 0.0) then ! call MOM_error(WARNING, & @@ -1724,18 +1729,18 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV if (n==1) then ! This is a u-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(I,K) > Kh_u(I,j,K)) then - dKh = (Kh(I,K) - Kh_u(I,j,K)) + if (Kh(I,K) > KH_u(I,j,K)) then + dKh = (Kh(I,K) - KH_u(I,j,K)) int_slope_u(I,j,K) = dKh / Kh(I,K) - Kh_u(I,j,K) = Kh(I,K) + KH_u(I,j,K) = Kh(I,K) endif enddo ; enddo else ! This is a v-column. do K=k_top+1,nz ; do i=ish,ie - if (Kh(i,K) > Kh_v(i,J,K)) then - dKh = Kh(i,K) - Kh_v(i,J,K) + if (Kh(i,K) > KH_v(i,J,K)) then + dKh = Kh(i,K) - KH_v(i,J,K) int_slope_v(i,J,K) = dKh / Kh(i,K) - Kh_v(i,J,K) = Kh(i,K) + KH_v(i,J,K) = Kh(i,K) endif enddo ; enddo endif @@ -1745,84 +1750,6 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV end subroutine add_detangling_Kh -!> Fills tracer values in massless layers with sensible values by diffusing -!! vertically with a (small) constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa, dt, T_f, S_f, G, GV, halo_here) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Input temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Input salinity [ppt] - real, intent(in) :: kappa !< Constant diffusivity to use [Z2 T-1 ~> m2 s-1] - real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filled salinity [ppt] - integer, optional, intent(in) :: halo_here !< Number of halo points to work on, - !! 0 by default - ! Local variables - real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz - ! between layers in a timestep [H ~> m or kg m-2]. - real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(G)) ! tridiagonal solver. - real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. - real :: h0 ! A negligible thickness to allow for zero - ! thicknesses [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]. 0 < h_neglect << h0. - real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness [H ~> m or kg m-2]. - integer :: i, j, k, is, ie, js, je, nz, halo - - halo=0 ; if (present(halo_here)) halo = max(halo_here,0) - - is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo - nz = G%ke - h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa*dt)*GV%Z_to_H**2 - h0 = 1.0e-16*sqrt(kappa*dt)*GV%Z_to_H - - if (kap_dt_x2 <= 0.0) then -!$OMP parallel do default(none) shared(is,ie,js,je,nz,T_f,T_in,S_f,S_in) - do k=1,nz ; do j=js,je ; do i=is,ie - T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) - enddo ; enddo ; enddo - else -!$OMP parallel do default(none) private(ent,b1,d1,c1,h_tr) & -!$OMP shared(is,ie,js,je,nz,kap_dt_x2,h,h0,h_neglect,T_f,S_f,T_in,S_in) - do j=js,je - do i=is,ie - ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) - h_tr = h(i,j,1) + h_neglect - b1(i) = 1.0 / (h_tr + ent(i,2)) - d1(i) = b1(i) * h(i,j,1) - T_f(i,j,1) = (b1(i)*h_tr)*T_in(i,j,1) - S_f(i,j,1) = (b1(i)*h_tr)*S_in(i,j,1) - enddo - do k=2,nz-1 ; do i=is,ie - ent(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0) - h_tr = h(i,j,k) + h_neglect - c1(i,k) = ent(i,K) * b1(i) - b1(i) = 1.0 / ((h_tr + d1(i)*ent(i,K)) + ent(i,K+1)) - d1(i) = b1(i) * (h_tr + d1(i)*ent(i,K)) - T_f(i,j,k) = b1(i) * (h_tr*T_in(i,j,k) + ent(i,K)*T_f(i,j,k-1)) - S_f(i,j,k) = b1(i) * (h_tr*S_in(i,j,k) + ent(i,K)*S_f(i,j,k-1)) - enddo ; enddo - do i=is,ie - c1(i,nz) = ent(i,nz) * b1(i) - h_tr = h(i,j,nz) + h_neglect - b1(i) = 1.0 / (h_tr + d1(i)*ent(i,nz)) - T_f(i,j,nz) = b1(i) * (h_tr*T_in(i,j,nz) + ent(i,nz)*T_f(i,j,nz-1)) - S_f(i,j,nz) = b1(i) * (h_tr*S_in(i,j,nz) + ent(i,nz)*S_f(i,j,nz-1)) - enddo - do k=nz-1,1,-1 ; do i=is,ie - T_f(i,j,k) = T_f(i,j,k) + c1(i,k+1)*T_f(i,j,k+1) - S_f(i,j,k) = S_f(i,j,k) + c1(i,k+1)*S_f(i,j,k+1) - enddo ; enddo - enddo - endif - -end subroutine vert_fill_TS - !> Initialize the thickness diffusion module/structure subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(time_type), intent(in) :: Time !< Current model time @@ -1837,7 +1764,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. - real :: omega, strat_floor, flux_to_kg_per_s + real :: omega ! The Earth's rotation rate [T-1 ~> s-1] + real :: strat_floor if (associated(CS)) then call MOM_error(WARNING, & @@ -1854,17 +1782,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "coefficient of KHTH.", default=.false.) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& "for the interface depth diffusivity", units="nondim", & default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX", CS%KHTH_Max, & "The maximum horizontal thickness diffusivity.", & - units = "m2 s-1", default=0.0) + default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTH_MAX_CFL", CS%max_Khth_CFL, & "The maximum value of the local diffusive CFL ratio that "//& "is permitted for the thickness diffusivity. 1.0 is the "//& @@ -1886,14 +1814,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "DETANGLE_TIMESCALE", CS%detangle_time, & "A timescale over which maximally jagged grid-scale "//& "thickness variations are suppressed. This must be "//& - "longer than DT, or 0 to use DT.", units = "s", default=0.0) + "longer than DT, or 0 to use DT.", units="s", default=0.0, scale=US%s_to_T) call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is "//& "not reliable and is scaled away.", units="nondim", default=0.01) 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.", & - default=1.0e-6, scale=US%m_to_Z**2) + default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) 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 "//& @@ -1912,9 +1840,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "streamfunction formulation, expressed as a fraction of planetary "//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mdl, "OMEGA",omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, do_not_log=.not.CS%use_FGNV_streamfn) + call get_param(param_file, mdl, "OMEGA", omega, & + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s, do_not_log=.not.CS%use_FGNV_streamfn) if (CS%use_FGNV_streamfn) CS%N2_floor = (strat_floor*omega)**2 call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -1930,7 +1858,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "MEKE_GEOMETRIC_EPSILON", CS%MEKE_GEOMETRIC_epsilon, & "Minimum Eady growth rate used in the calculation of \n"//& - "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7) + "GEOMETRIC thickness diffusivity.", units="s-1", default=1.0e-7, scale=US%T_to_s) call get_param(param_file, mdl, "MEKE_GEOMETRIC_ALPHA", CS%MEKE_GEOMETRIC_alpha, & "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//& @@ -1950,16 +1878,15 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call safe_alloc_ptr(CS%KH_v_GME,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) endif - if (GV%Boussinesq) then ; flux_to_kg_per_s = GV%Rho0 - else ; flux_to_kg_per_s = 1. ; endif - CS%id_uhGM = register_diag_field('ocean_model', 'uhGM', diag%axesCuL, Time, & - 'Time Mean Diffusive Zonal Thickness Flux', 'kg s-1', & - y_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Zonal Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + y_cell_method='sum', v_extensive=.true.) if (CS%id_uhGM > 0) call safe_alloc_ptr(CDp%uhGM,G%IsdB,G%IedB,G%jsd,G%jed,G%ke) CS%id_vhGM = register_diag_field('ocean_model', 'vhGM', diag%axesCvL, Time, & - 'Time Mean Diffusive Meridional Thickness Flux', 'kg s-1', & - x_cell_method='sum', v_extensive=.true., conversion=flux_to_kg_per_s) + 'Time Mean Diffusive Meridional Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + x_cell_method='sum', v_extensive=.true.) if (CS%id_vhGM > 0) call safe_alloc_ptr(CDp%vhGM,G%isd,G%ied,G%JsdB,G%JedB,G%ke) CS%id_GMwork = register_diag_field('ocean_model', 'GMwork', diag%axesT1, Time, & @@ -1970,22 +1897,28 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) if (CS%id_GMwork > 0) call safe_alloc_ptr(CS%GMwork,G%isd,G%ied,G%jsd,G%jed) CS%id_KH_u = register_diag_field('ocean_model', 'KHTH_u', diag%axesCui, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v = register_diag_field('ocean_model', 'KHTH_v', diag%axesCvi, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-point', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-point', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t = register_diag_field('ocean_model', 'KHTH_t', diag%axesTL, Time, & - 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', 'm2 s-1',& + 'Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrblo', & cmor_long_name='Ocean Tracer Diffusivity due to Parameterized Mesoscale Advection', & cmor_units='m2 s-1', & cmor_standard_name='ocean_tracer_diffusivity_due_to_parameterized_mesoscale_advection') CS%id_KH_u1 = register_diag_field('ocean_model', 'KHTH_u1', diag%axesCu1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at U-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_v1 = register_diag_field('ocean_model', 'KHTH_v1', diag%axesCv1, Time, & - 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at V-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KH_t1 = register_diag_field('ocean_model', 'KHTH_t1', diag%axesT1, Time,& - 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', 'm2 s-1') + 'Parameterized mesoscale eddy advection diffusivity at T-points (2-D)', & + 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_slope_x = register_diag_field('ocean_model', 'neutral_slope_x', diag%axesCui, Time, & 'Zonal slope of neutral surface', 'nondim') @@ -1994,15 +1927,17 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 'Meridional slope of neutral surface', 'nondim') if (CS%id_slope_y > 0) call safe_alloc_ptr(CS%diagSlopeY,G%isd,G%ied,G%JsdB,G%JedB,G%ke+1) CS%id_sfn_x = register_diag_field('ocean_model', 'GM_sfn_x', diag%axesCui, Time, & - 'Parameterized Zonal Overturning Streamfunction', 'm3 s-1') + 'Parameterized Zonal Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_y = register_diag_field('ocean_model', 'GM_sfn_y', diag%axesCvi, Time, & - 'Parameterized Meridional Overturning Streamfunction', 'm3 s-1') + 'Parameterized Meridional Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_x = register_diag_field('ocean_model', 'GM_sfn_unlim_x', diag%axesCui, Time, & 'Parameterized Zonal Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) CS%id_sfn_unlim_y = register_diag_field('ocean_model', 'GM_sfn_unlim_y', diag%axesCvi, Time, & 'Parameterized Meridional Overturning Streamfunction before limiting/smoothing', & - 'm3 s-1', conversion=US%Z_to_m) + 'm3 s-1', conversion=US%Z_to_m*US%L_to_m**2*US%s_to_T) end subroutine thickness_diffuse_init @@ -2011,10 +1946,10 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G) type(thickness_diffuse_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME!< interface height - !! diffusivities in u-columns [m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME!< interface height - !! diffusivities in v-columns [m2 s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: KH_u_GME !< interface height + !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: KH_v_GME !< interface height + !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! Local variables integer :: i,j,k diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index f281a7b927..2ff0b3efe1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -468,10 +468,12 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) ! CMOR names are placeholders; must be modified by time period ! for CMOR compliance. Diag manager will be used for omlmax and ! omldamax. - CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & - cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & - cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') + if (CS%n_smooth > 0) then + CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & + 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & + cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & + cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') + endif CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', 'kg/m3') CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & @@ -489,9 +491,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & - 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m) + 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & - 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3') + 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s') CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & @@ -499,7 +501,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', '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%Z_to_m**2) + 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_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') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -590,17 +592,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] + 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_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport [m s-1] @@ -614,6 +616,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & real :: surfFricVel, surfBuoyFlux real :: sigma, sigmaRatio + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] real :: dh ! The local thickness used for calculating interface positions [m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] @@ -624,10 +627,10 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then 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) + 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) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z_to_m**2) + 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) endif #endif @@ -635,6 +638,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + buoy_scale = US%L_to_m**2*US%s_to_T**3 + !$OMP parallel do default(shared) firstprivate(nonLocalTrans) ! loop over horizontal points on processor do j = G%jsc, G%jec @@ -644,7 +649,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - surfFricVel = US%Z_to_m * uStar(i,j) + surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. @@ -660,7 +665,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & enddo ! k-loop finishes - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -670,12 +675,12 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & !BGR/ Add option for use of surface buoyancy flux with total sw flux. if (CS%SW_METHOD == SW_METHOD_ALL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) + surfBuoyFlux = buoy_scale * buoyFlux(i,j,1) elseif (CS%SW_METHOD == SW_METHOD_MXL_SW) then ! We know the actual buoyancy flux into the OBL - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) + surfBuoyFlux = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1)) elseif (CS%SW_METHOD == SW_METHOD_LV1_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) + surfBuoyFlux = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,2)) endif ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. @@ -683,9 +688,9 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] Kviscosity(:) = 0. ! Viscosity [m2 s-1] else - Kdiffusivity(:,1) = US%Z_to_m**2 * Kt(i,j,:) - Kdiffusivity(:,2) = US%Z_to_m**2 * Ks(i,j,:) - Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) + 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,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] @@ -739,7 +744,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kviscosity(k) = Kviscosity(k) * LangEnhK elseif (CS%LT_K_SHAPE == LT_K_SCALED) then sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - SigmaRatio = sigma * (1. - sigma)**2. / 0.148148037 + SigmaRatio = sigma * (1. - sigma)**2 / 0.148148037 if (CS%id_EnhK > 0) CS%EnhK(i,j,k) = (1.0 + (LangEnhK - 1.)*sigmaRatio) Kdiffusivity(k,1) = Kdiffusivity(k,1) * ( 1. + & ( LangEnhK - 1.)*sigmaRatio) @@ -828,17 +833,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) + 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) + 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, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) + 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 (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo endif endif @@ -851,8 +856,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z_to_m**2) + 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) endif #endif @@ -885,11 +890,11 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity [ppt] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [L T-1 ~> m s-1] type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] + 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_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS ! Local variables @@ -910,11 +915,13 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension( 3*G%ke ) :: Salt_1D real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average [m] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> nondim] real :: delH ! Thickness of a layer [m] real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer @@ -946,7 +953,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF #endif ! some constants - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = GV%mks_g_Earth / GV%Rho0 + buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor !$OMP parallel do default(shared) @@ -957,14 +965,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (G%mask2dT(i,j)==0.) cycle do k=1,G%ke - U_H(k) = 0.5 * (U(i,j,k)+U(i-1,j,k)) - V_H(k) = 0.5 * (V(i,j,k)+V(i,j-1,k)) + U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) + V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) enddo ! things independent of position within the column Coriolis = 0.25*US%s_to_T*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) - surfFricVel = US%Z_to_m * uStar(i,j) + surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) ! Bullk Richardson number computed for each cell in a column, ! assuming OBLdepth = grid cell depth. After Rib(k) is @@ -1015,8 +1023,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH - surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH - surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then surfHus = surfHus + 0.5*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH surfHvs = surfHvs + 0.5*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH @@ -1033,8 +1041,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! vertical shear between present layer and ! surface layer averaged surfU,surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then @@ -1067,14 +1075,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF pRef = pRef + GV%H_to_Pa * h(i,j,k) ! this difference accounts for penetrating SW - surfBuoyFlux2(k) = buoyFlux(i,j,1) - buoyFlux(i,j,k+1) + surfBuoyFlux2(k) = buoy_scale * (buoyFlux(i,j,1) - buoyFlux(i,j,k+1)) enddo ! k-loop finishes if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, US, MLD_guess, surfFricVel, i, j, & - H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) + 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) CS%La_SL(i,j)=LA endif @@ -1137,7 +1145,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_LF17) then CS%CS=cvmix_get_kpp_real('c_s',CS%KPP_params) do k=1,G%ke - WST = (max(0.,-buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) + WST = (max(0.,-buoy_scale*buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & (1.+0.49*CS%La_SL(i,j)**(-2.))) / & (0.2*ws_1d(k)**3/(CS%cs*CS%surf_layer_ext*CS%vonKarman**4.))) @@ -1166,7 +1174,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF N_iface=CS%N(i,j,:)) ! Buoyancy frequency [s-1] - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + surfBuoyFlux = buoy_scale * buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) call CVMix_kpp_compute_OBL_depth( & @@ -1209,15 +1217,15 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = h(i,j,1) ! surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot ! surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - ! surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - ! surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + ! surfU = 0.5*US%L_T_to_m_s*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + ! surfV = 0.5*US%L_T_to_m_s*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot ! pRef = 0.0 ! do k = 2, G%ke ! ! Recalculate differences with surface layer - ! Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - ! Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + ! Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU + ! Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV ! deltaU2(k) = Uk**2 + Vk**2 ! pRef = pRef + GV%H_to_Pa * h(i,j,k) ! call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) @@ -1230,8 +1238,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! hTot = hTot + delH ! surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot ! surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - ! surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - ! surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + ! surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + ! surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot ! endif ! enddo @@ -1243,7 +1251,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] ! N_iface=CS%N ) ! Buoyancy frequency [s-1] - ! surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! ! h to Monin-Obukov (default is false, ie. not used) ! call CVMix_kpp_compute_OBL_depth( & diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 1a9cb890ef..1fbbc15120 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -42,8 +42,8 @@ module MOM_CVMix_conv ! Diagnostics arrays real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] - real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [m2 s-1] - real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [m2 s-1] + real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [Z2 T-1 ~> m2 s-1] end type CVMix_conv_cs @@ -134,9 +134,9 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & @@ -168,10 +168,11 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers [m] integer :: kOBL !< level of OBL extent - real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + real :: g_o_rho0 ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pref, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + g_o_rho0 = GV%mks_g_Earth / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 @@ -231,8 +232,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) OBL_ind=kOBL) do K=1,G%ke+1 - CS%kv_conv(i,j,K) = US%m_to_Z**2 * kv_col(K) - CS%kd_conv(i,j,K) = US%m_to_Z**2 * kd_col(K) + CS%kv_conv(i,j,K) = US%m2_s_to_Z2_T * kv_col(K) + CS%Kd_conv(i,j,K) = US%m2_s_to_Z2_T * kd_col(K) enddo ! Do not apply mixing due to convection within the boundary layer do k=1,kOBL @@ -245,8 +246,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) if (CS%debug) then call hchksum(CS%N2, "MOM_CVMix_conv: N2",G%HI,haloshift=0) - call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0) - call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0) + call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0,scale=US%Z2_T_to_m2_s) + call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0,scale=US%m2_s_to_Z2_T) 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 4f535197a7..57400e31bf 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -138,10 +138,10 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z2_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%Z_to_m**2) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') @@ -170,9 +170,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), 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_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp [Z2 s-1 ~> m2 s-1]. + !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt [Z2 s-1 ~> m2 s-1]. + !! diffusivity for salt [Z2 T-1 ~> m2 s-1]. type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. @@ -275,8 +275,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - Kd_T(i,j,K) = US%m_to_Z**2 * Kd1_T(K) - Kd_S(i,j,K) = US%m_to_Z**2 * Kd1_S(K) + 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) 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 9e0f6ca708..3ab0567db1 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -59,21 +59,22 @@ module MOM_CVMix_shear subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) type(ocean_grid_type), intent(in) :: 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_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points [m s-1]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T + !! points [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), 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_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. - type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. + type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous + !! call to CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho - real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pref, DU, DV, dRho, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] @@ -81,7 +82,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = GV%mks_g_Earth / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec @@ -118,8 +119,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) do k = 1, G%ke km1 = max(1, k-1) 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)) + DU = US%L_T_to_m_s*(u_h(i,j,k) - u_h(i,j,km1)) + DV = US%L_T_to_m_s*(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_m) N2 = DRHO/DZ @@ -156,8 +157,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) endif do K=1,G%ke+1 - Kvisc(K) = US%Z_to_m**2 * kv(i,j,K) - Kdiff(K) = US%Z_to_m**2 * kd(i,j,K) + Kvisc(K) = US%Z2_T_to_m2_s * kv(i,j,K) + Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. @@ -167,8 +168,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - kv(i,j,K) = US%m_to_Z**2 * Kvisc(K) - kd(i,j,K) = US%m_to_Z**2 * Kdiff(K) + kv(i,j,K) = US%m2_s_to_Z2_T * Kvisc(K) + kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K) enddo enddo enddo @@ -289,9 +290,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%Z_to_m**2) + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_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%Z_to_m**2) + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_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 e941ec3eea..0cbe700518 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -47,15 +47,16 @@ module MOM_bkgnd_mixing real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the !! Bryan-Lewis profile [m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when - !! horiz_varying_background=.true. + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when - !! horiz_varying_background=.true. + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when - !! horiz_varying_background=.true. - real :: bckgrnd_vdc_ban !< Banda Sea diffusivity (Gordon) when - !! horiz_varying_background=.true. - real :: Kd_min !< minimum diapycnal diffusivity [Z2 s-1 ~> m2 s-1] - real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 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] + 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 !! Henyey scaling from the mixing @@ -64,7 +65,7 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness [Z ~> m] when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on @@ -100,9 +101,9 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 T-1 ~> m2 s-1] ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity [Z2 s-1 ~> m2 s-1] character(len=40) :: bkgnd_scheme_str = "none" !< Background scheme identifier @@ -125,7 +126,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables - real :: Kv ! The interior vertical viscosity [m2 s-1] - read to set prandtl + real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set prandtl ! number unless it is provided as a parameter real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. @@ -146,16 +147,16 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the "//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& - "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) 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", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_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%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) ! The following is needed to set one of the choices of vertical background mixing @@ -175,7 +176,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "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%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) 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 "//& @@ -194,30 +195,25 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%Bryan_Lewis_diffusivity) then call check_bkgnd_scheme(CS, "BRYAN_LEWIS_DIFFUSIVITY") - call get_param(param_file, mdl, "BRYAN_LEWIS_C1", & - CS%Bryan_Lewis_c1, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C1", CS%Bryan_Lewis_c1, & "The vertical diffusivity values for Bryan-Lewis profile at |z|=D.", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C2", & - CS%Bryan_Lewis_c2, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C2", CS%Bryan_Lewis_c2, & "The amplitude of variation in diffusivity for the Bryan-Lewis profile", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C3", & - CS%Bryan_Lewis_c3, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C3", CS%Bryan_Lewis_c3, & "The inverse length scale for transition region in the Bryan-Lewis profile", & units="m-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C4", & - CS%Bryan_Lewis_c4, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C4", CS%Bryan_Lewis_c4, & "The depth where diffusivity is BRYAN_LEWIS_C1 in the Bryan-Lewis profile",& units="m", fail_if_missing=.true.) endif ! CS%Bryan_Lewis_diffusivity - call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", & - CS%horiz_varying_background, & + call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", CS%horiz_varying_background, & "If true, apply vertically uniform, latitude-dependent background "//& "diffusivity, as described in Danabasoglu et al., 2012", & default=.false.) @@ -225,25 +221,21 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%horiz_varying_background) then call check_bkgnd_scheme(CS, "HORIZ_VARYING_BACKGROUND") - call get_param(param_file, mdl, "BCKGRND_VDC1", & - CS%bckgrnd_vdc1, & + 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%m_to_Z**2) + units="m2 s-1",default = 0.16e-04, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_EQ", & - CS%bckgrnd_vdc_eq, & + 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%m_to_Z**2) + units="m2 s-1",default = 0.01e-04, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", & - CS%bckgrnd_vdc_psim, & + 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%m_to_Z**2) + units="m2 s-1",default = 0.13e-4, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_BAN", & - CS%bckgrnd_vdc_ban, & + 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%m_to_Z**2) + units="m2 s-1",default = 1.0e-4, scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & @@ -283,11 +275,15 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "diffusivity (KD) is specified along with "//trim(CS%bkgnd_scheme_str)) endif - if (CS%Henyey_IGW_background) & + if (CS%Henyey_IGW_background) then call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & "The ratio of the typical Buoyancy frequency to twice "//& "the Earth's rotation period, used with the Henyey "//& "scaling from the mixing.", units="nondim", default=20.0) + 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, "KD_TANH_LAT_FN", & CS%Kd_tanh_lat_fn, & @@ -308,16 +304,16 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! call closeParameterBlock(param_file) ! allocate arrays and set them to zero - allocate(CS%kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. + allocate(CS%Kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. allocate(CS%kv_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_bkgnd(:,:,:) = 0. allocate(CS%Kd_sfc(SZI_(G), SZJ_(G))); CS%Kd_sfc(:,:) = 0. ! Register diagnostics CS%diag => diag 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%Z_to_m**2) + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_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%Z_to_m**2) + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) end subroutine bkgnd_mixing_init @@ -370,7 +366,7 @@ subroutine sfc_bkgnd_mixing(G, US, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z_to_m**2) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) end subroutine sfc_bkgnd_mixing @@ -388,7 +384,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd_lay !< Diapycnal diffusivity of each layer !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1] + !! (not layer!) [Z2 T-1 ~> m2 s-1] integer, intent(in) :: j !< Meridional grid index type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. @@ -400,15 +396,15 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) 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 :: I_2Omega !< 1/(2 Omega) [s] - real :: N_2Omega - real :: N02_N2 - real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) + 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] + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. real :: abs_sin !< absolute value of sine of latitude [nondim] - real :: epsilon - real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere - real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere + real :: epsilon ! 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] integer :: i, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -439,8 +435,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) ! Update Kd and Kv. do K=1,nz+1 - CS%Kv_bkgnd(i,j,K) = US%m_to_Z**2*Kv_col(K) - CS%Kd_bkgnd(i,j,K) = US%m_to_Z**2*Kd_col(K) + CS%Kv_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kv_col(K) + CS%Kd_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kd_col(K) enddo do k=1,nz Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_col(K) + Kd_col(K+1)) @@ -456,7 +452,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd_lay(i,j,k) = US%T_to_s * ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif @@ -464,61 +460,64 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) enddo ; enddo elseif (CS%horiz_varying_background) then + !### Note that there are lots of hard-coded parameters (mostly latitudes and longitudes) here. do i=is,ie - bckgrnd_vdc_psis= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)+28.9))**2.0) - bckgrnd_vdc_psin= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)-28.9))**2.0) - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis + bckgrnd_vdc_psis = CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)+28.9))**2) + bckgrnd_vdc_psin = CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)-28.9))**2) + !### Add parentheses. + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis if (G%geoLatT(i,j) < -10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 elseif (G%geoLatT(i,j) <= 10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2.0 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2 else - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 endif ! North Banda Sea if ( (G%geoLatT(i,j) < -1.0) .and. (G%geoLatT(i,j) > -4.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 103.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 134.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! Middle Banda Sea if ( (G%geoLatT(i,j) <= -4.0) .and. (G%geoLatT(i,j) > -7.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 106.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 140.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! South Banda Sea if ( (G%geoLatT(i,j) <= -7.0) .and. (G%geoLatT(i,j) > -8.3) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 111.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 142.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! Compute kv_bkgnd - CS%kv_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) * CS%prandtl_bkgnd + CS%kv_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) * CS%prandtl_bkgnd ! Update Kd (uniform profile; no interpolation needed) - Kd_lay(i,j,:) = US%T_to_s * CS%kd_bkgnd(i,j,1) + Kd_lay(i,j,:) = CS%Kd_bkgnd(i,j,1) enddo elseif (CS%Henyey_IGW_background_new) then I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. + I_2Omega = 0.5 / CS%omega do k=1,nz ; do i=is,ie - abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin,sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) + abs_sin = max(epsilon, abs(sin(G%geoLatT(i,j)*deg_to_rad))) + N_2Omega = max(abs_sin, sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,j,k) = US%T_to_s * max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = US%T_to_s * CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -528,7 +527,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%Kd_bkgnd(i,j,k) = US%s_to_T * (0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K))) + CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 17b7bb5c15..cbf42d2b8b 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -11,7 +11,7 @@ module MOM_bulk_mixed_layer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : extractFluxes1d, forcing use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : absorbRemainingSW, optics_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 @@ -52,9 +52,9 @@ module MOM_bulk_mixed_layer 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 !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m 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. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in degC / ppt) is !! combined with the derivatives of density with T & S @@ -62,12 +62,21 @@ module MOM_bulk_mixed_layer !! density contours. It should be a typical value of !! (dR/dS) / (dR/dT) in oceanic profiles. !! 6 degC ppt-1 might be reasonable. + real :: Hbuffer_min !< The minimum buffer layer thickness when the mixed layer + !! is very large [H ~> m or kg m-2]. + real :: Hbuffer_rel_min !< The minimum buffer layer thickness relative to the combined + !! mixed and buffer layer thicknesses when they are thin [nondim] + real :: BL_detrain_time !< A timescale that characterizes buffer layer detrainment + !! events [T ~> s]. real :: BL_extrap_lim !< A limit on the density range over which !! extrapolation can occur when detraining from the !! buffer layers, relative to the density range !! within the mixed and buffer layers, when the !! detrainment is going into the lightest interior - !! layer, nondimensional. + !! layer [nondim]. + real :: BL_split_rho_tol !< The fractional tolerance for matching layer target densities + !! when splitting layers to deal with massive interior layers + !! that are lighter than one of the mixed or buffer layers [nondim]. logical :: ML_resort !< If true, resort the layers by density, rather than !! doing convective adjustment. integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective @@ -110,7 +119,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, ppt. - ! These are terms in the mixed layer TKE budget, all in [Z m2 s-3 ~> m3 s-3]. + ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] 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. @@ -121,8 +130,10 @@ module MOM_bulk_mixed_layer diag_TKE_conv_decay, & !< The decay of convective TKE. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. - diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3. - diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer + !! detrainment [kg T-3 Z m-1 ~> W m-2]. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only + !! detrainment [kg T-3 Z m-1 ~> W m-2]. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -173,7 +184,7 @@ module MOM_bulk_mixed_layer !! For a traditional Kraus-Turner mixed layer, the values are: !! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, !! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & +subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, US, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -182,17 +193,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C intent(inout) :: h_3d !< Layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to @@ -213,7 +224,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! being applied separately. real, optional, intent(in) :: dt_diag !< The diagnostic time step, !! which may be less than dt if there are - !! two callse to mixedlayer [s]. + !! two callse to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< if true, this is the last call !! to mixedlayer in the current time step, so !! diagnostics will be written. The default is @@ -236,8 +247,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C R0, & ! The potential density referenced to the surface [kg m-3]. Rcv ! The coordinate variable potential density [kg m-3]. real, dimension(SZI_(G),SZK_(GV)) :: & - u, & ! The zonal velocity [m s-1]. - v, & ! The meridional velocity [m s-1]. + u, & ! The zonal velocity [L T-1 ~> m s-1]. + v, & ! The meridional velocity [L T-1 ~> m s-1]. h_orig, & ! The original thickness [H ~> m or kg m-2]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -252,9 +263,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C h_miss ! The summed absolute mismatch [Z ~> m]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step [Z m2 s-2 ~> m3 s-2]. + ! time step [Z L2 T-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection [Z m2 s-2 ~> m3 s-2]. + ! the depth of free convection [Z L2 T-2 ~> m3 s-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 @@ -266,7 +277,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the @@ -289,8 +300,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! salinity [kg m-3 ppt-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. - TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step [Z m2 s-2 ~> m3 s-2]. + TKE_river ! The source of turbulent kinetic energy available for mixing + ! at rivermouths [Z L2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -304,19 +315,18 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: Irho0 ! 1.0 / rho_0 [m3 kg-1] real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the timestep [s-1]. - real :: Idt_diag ! The inverse of the timestep used for diagnostics [s-1]. + real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1]. real :: RmixConst real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection - ! [Z m2 s-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-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 m2 s-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment [Z m2 s-2 ~> m3 s-2]. + ! adjustment [Z L2 T-2 ~> m3 s-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 [Z ~> m]. @@ -335,9 +345,10 @@ 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. 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 s-1 ~> m s-1]. - real :: kU_star ! Ustar times the Von Karmen constant [Z s-1 ~> m s-1]. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. + 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 Karmen constant [Z T-1 ~> m s-1]. +! real :: dt_in_T ! Time increment in time units [T ~> s]. + real :: dt__diag ! A recaled 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. integer :: i, j, k, is, ie, js, je, nz, nkmb, n @@ -359,10 +370,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) +! dt_in_T = dt * US%s_to_T + Irho0 = 1.0 / GV%Rho0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - Idt = 1.0 / dt - Idt_diag = 1.0 / dt__diag + dt__diag = dt_in_T ; if (present(dt_diag)) dt__diag = dt_diag + Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref @@ -394,7 +406,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Determine whether to zero out diagnostics before accumulation. reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & + if (present(dt_diag) .and. write_diags .and. (dt__diag > dt_in_T)) & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then @@ -442,10 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C h_orig(i,k) = h_3d(i,j,k) 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) - do n=1,nsw - opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k) - enddo enddo ; enddo + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_m) do k=1,nz ; do i=is,ie d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 @@ -473,7 +483,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & - S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS, & + S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS, & CS%ML_presort_nz_conv_adj) call sort_ML(h(:,1:), R0(:,1:), eps, G, GV, CS, ksort) @@ -486,7 +496,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & - S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS) + S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) @@ -507,7 +517,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * 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)) + US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) enddo else do i=is,ie ; TKE_river(i) = 0.0 ; enddo @@ -523,7 +533,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, fluxes, optics, nsw, j, US%T_to_s*dt_in_T, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -534,22 +544,22 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C R0(:,1:), Rcv(:,1:), eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & - dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the - ! surface is becoming lighter, and is effectively detraining. + ! surface is becoming lighter, and is effecti1336vely detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) 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, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & j, ksort, G, GV, US, CS) ! Here the mechanically driven entrainment occurs. @@ -558,12 +568,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, US, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & - CS%correct_absorption, CS%absorb_all_SW, & + call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, optics, j, dt_in_T, & + CS%H_limit_fluxes, CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) if (CS%TKE_diagnostics) then ; do i=is,ie - CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag*TKE(i) + CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag * TKE(i) enddo ; endif if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) @@ -632,11 +642,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, d_eb, j, G, GV, CS, & + GV%Rlay, dt_in_T, 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:), & - GV%Rlay, dt, dt__diag, d_ea, j, G, GV, CS, & + GV%Rlay, dt_in_T, dt__diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_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. @@ -663,20 +673,19 @@ 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 = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_star = 0.41*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 + & + kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * US%m_to_Z * US%s_to_T * h(i,0) * & !### I think this should be H_to_Z -RWH + absf_x_H = 0.25 * GV%H_to_Z * 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 ! MOM_vert_friction.F90, this line will have to be modified accordingly. - h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / & - (kU_star**2)) ) + h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / kU_star**2)) do k=2,CS%nkml ! The other layers are evenly distributed through the mixed layer. h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1 @@ -793,15 +802,15 @@ end subroutine bulkmixedlayer !! 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, & - dKE_CA, cTKE, j, G, GV, CS, nz_conv) + 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. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. !! The units of h are referred to as H below. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h - !! points, m s-1. + !! points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S !< Layer salinities [ppt]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to @@ -816,11 +825,12 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 s-2 ~> m3 s-2]. + !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-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), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment @@ -843,15 +853,15 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Stot, & ! The integrated salt of layers which are fully entrained ! [H ppt ~> m ppt or ppt kg m-2]. uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. KE_orig, & ! The total mean kinetic energy in the mixed layer before - ! convection, H m2 s-2. + ! convection, [H L2 T-2 ~> H m2 s-2]. 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 ! the conversion from H to Z divided by the mean density, - ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS + ! in [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke @@ -927,8 +937,8 @@ 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, & netMassInOut, netMassOut, Net_heat, Net_salt, & - nsw, Pen_SW_bnd, opacity_band, Conv_en, & - dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & + nsw, Pen_SW_bnd, opacity_band, Conv_En, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -945,17 +955,17 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! 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 kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer coordinate !! variable potential density [H kg m-2 ~> kg m-1 or kg2 m-4]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -989,29 +999,27 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! over a time step [ppt H ~> ppt m or ppt kg m-2]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave - !! heating at the sea surface in each - !! penetrating band [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies of opacity_band are band, i, k. - real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 s-2 ~> m3 s-2]. + real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave + !! heating at the sea surface in each penetrating + !! band [degC H ~> degC m or degC kg m-2]. + 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]. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection [Z m2 s-2 ~> m3 s-2]. + !! energy due to free convection [Z L2 T-2 ~> m3 s-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. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this - !! module. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -1045,13 +1053,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! [m7 s-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. 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 ! shortwave radiation, integrated over a layer ! [H kg m-3 ~> kg m-2 or kg2 m-5]. - real :: Idt ! 1.0/dt [s-1] + real :: Idt ! 1.0/dt [T-1 ~> s-1] real :: netHeatOut ! accumulated heat content of mass leaving ocean integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & @@ -1061,7 +1069,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) - Idt = 1.0/dt + Idt = 1.0 / dt_in_T is = G%isc ; ie = G%iec ; nz = GV%ke do i=is,ie ; if (ksort(i,1) > 0) then @@ -1114,8 +1122,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & dRcv_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i))) Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) & - + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + US%s_to_T * & + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T_precip * netMassIn(i) * GV%H_to_kg_m2 endif ; enddo @@ -1166,9 +1174,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_kg_m2*fluxes%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. - if (associated(fluxes%heat_content_massout)) & - fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) & - - T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massout)) & + fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) - US%s_to_T * & + T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & T(i,k)*h_evap*GV%H_to_kg_m2 @@ -1284,6 +1292,8 @@ 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 uhtot(i) = u(i,k)*h_ent ; vhtot(i) = v(i,k)*h_ent + !### I think that the line above should instead be: + ! uhtot(i) = uhtot(i) + h_ent*u(i,k) ; vhtot(i) = vhtot(i) + h_ent*v(i,k) endif @@ -1296,7 +1306,7 @@ 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, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, 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. @@ -1309,31 +1319,31 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 s-2 ~> m3 s-2]. + !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 s-2 ~> m3 s-2]. + !! adjustment [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step [Z m2 s-2 ~> m3 s-2]. + !! mixing over a time step [Z m2 T-2 ~> m3 s-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 turbulent kinetic energy available - !! for driving mixing at river mouths - !! integrated over a time step [Z m2 s-2 ~> m3 s-2]. + 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]. 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]. - real, intent(in) :: dt !< The time step [s]. + real, intent(in) :: dt_in_T !< The time step [T ~> s]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval [s-1]. + !! time interval [T-1 ~> s-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. @@ -1343,46 +1353,46 @@ 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 m2 s-2 ~> m3 s-2]. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z L2 T-2 ~> m3 s-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 m2 s-2 ~> m3 s-2]. + ! that release is positive [Z L2 T-2 ~> m3 s-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 s-2 ~> m3 s-2]. + real :: totEn_Z ! The total potential energy released by convection, [Z3 T-2 ~> m3 s-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 [s-1]. - real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. + 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 m2 s-3 ~> m3 s-3]. + real :: wind_TKE_src ! The surface wind source of TKE [Z L2 T-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls) [nondim]. integer :: is, ie, nz, i is = G%isc ; ie = G%iec ; nz = GV%ke - diag_wt = dt * Idt_diag + diag_wt = dt_in_T * Idt_diag if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = fluxes%ustar(i,j) + U_star = fluxes%ustar(i,j) 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 + & + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (U_star < CS%ustar_min) U_star = CS%ustar_min if (CS%omega_frac < 1.0) then - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + 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 + absf_Ustar = absf / U_star Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z ! The first number in the denominator could be anywhere up to 16. The @@ -1395,7 +1405,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! 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*0.41*U_star*dt) - Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt_in_T) cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then @@ -1410,11 +1420,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) < 0.0) Conv_En(i) = 0.0 if (cTKE(i,1) > 0.0) then ; TKE_CA = cTKE(i,1) ; else ; TKE_CA = 0.0 ; endif if ((htot(i) >= h_CA(i)) .or. (TKE_CA == 0.0)) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) + totEn_Z = US%L_to_Z**2 * (Conv_En(i) + TKE_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_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1422,17 +1432,17 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, else ! This reconstructs the Buoyancy flux within the topmost htot of water. if (Conv_En(i) > 0.0) then - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) + 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_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif - totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_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_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1454,15 +1464,15 @@ 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_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt_in_T*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 (CS%do_rivermix) then ! Add additional TKE at river mouths - TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh + TKE(i) = TKE(i) + TKE_river(i)*dt_in_T*exp_kh endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(US%Z_to_L**2*U_star*U_Star*U_Star) * diag_wt 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 @@ -1500,17 +1510,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity !! [ppt H ~> ppt m or ppt kg m-2]. real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer zonal - !! velocity, H m s-1. + !! velocity [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer meridional - !! velocity, H m s-1. + !! 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 kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer coordinate variable !! potential density [H kg m-3 ~> kg m-2 or kg2 m-5]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: u !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: v !< Zonal velocities interpolated to h points, m s-1. + intent(in) :: v !< Zonal velocities interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: T !< Layer temperatures [degC]. real, dimension(SZI_(G),SZK_(GV)), & @@ -1532,19 +1542,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! denominator of MKE_rate; the two elements have differing !! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval [s-1]. + !! time interval [T-1 ~> s-1]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave heating at the - !! sea surface in each penetrating band - !! [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(:,:,:), intent(in) :: opacity_band !< The opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies of opacity_band are (band, i, k). + real, dimension(max(nsw,1),SZI_(G)), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave + !! heating at the sea surface in each penetrating + !! band [degC H ~> degC m or degC kg m-2]. + 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(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step [Z m2 s-2 ~> m3 s-2]. + !! step [Z m2 T-2 ~> m3 s-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)), & @@ -1569,22 +1577,22 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, - ! in m5 s-2 H-1 kg-1. + ! in [L2 m3 T-2 H-1 kg-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 m2 s-2 ~> m3 s-2]. + ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [m2 s-2]. + ! across the mixed layer [L2 T-2 ~> L2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [m2 s-2]. - real :: C1 ! A temporary variable [m2 s-2]. + ! TKE, divided by layer thickness in m [L2 T2 ~> 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, with units of H Z m2 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 s-2 ~> m3 s-2]. + ! 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]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy [Z m2 s-2 ~> m3 s-2]. - real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. + ! 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]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to - ! dTKE_dh [m2 s-2]. + ! 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]. 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]. @@ -1671,8 +1679,7 @@ 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*GV%H_to_Z)*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 @@ -1683,7 +1690,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z + !### The minimum TKE value in this line may be problematically small. + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z*US%m_s_to_L_T**2 else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1736,13 +1744,13 @@ 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 - C1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i) - Pen_En_Contrib = Pen_En_Contrib + C1*(Pen_En1 - f1_kh) + Cpen1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i) + Pen_En_Contrib = Pen_En_Contrib + Cpen1*(Pen_En1 - f1_kh) Pen_dTKE_dh_Contrib = Pen_dTKE_dh_Contrib + & - C1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) + 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*GV%H_to_Z)*(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)) @@ -1784,8 +1792,7 @@ 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*GV%H_to_Z)*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 @@ -1939,7 +1946,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real :: h_move, h_tgt_old, I_hnew real :: dT_dS_wt2, dT_dR, dS_dR, I_denom real :: Rcv_int - real :: target_match_tol real :: T_up, S_up, R0_up, I_hup, h_to_up real :: T_dn, S_dn, R0_dn, I_hdn, h_to_dn real :: wt_dn @@ -1956,7 +1962,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS is = G%isc ; ie = G%iec ; nz = GV%ke nkmb = CS%nkml+CS%nkbl - target_match_tol = 0.1 ! ### MAKE THIS A PARAMETER. dT_dS_wt2 = CS%dT_dS_wt**2 @@ -2018,10 +2023,10 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS k = ks2(ks) leave_in_layer = .false. if ((k > nkmb) .and. (Rcv(i,k) <= RcvTgt(k))) then - if (RcvTgt(k)-Rcv(i,k) < target_match_tol*(RcvTgt(k) - RcvTgt(k-1))) & + if (RcvTgt(k)-Rcv(i,k) < CS%BL_split_rho_tol*(RcvTgt(k) - RcvTgt(k-1))) & leave_in_layer = .true. elseif (k > nkmb) then - if (Rcv(i,k)-RcvTgt(k) < target_match_tol*(RcvTgt(k+1) - RcvTgt(k))) & + if (Rcv(i,k)-RcvTgt(k) < CS%BL_split_rho_tol*(RcvTgt(k+1) - RcvTgt(k))) & leave_in_layer = .true. endif @@ -2199,7 +2204,7 @@ 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, CS, & +subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_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. @@ -2213,13 +2218,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer [kg m-3]. - real, intent(in) :: dt !< Time increment [s]. - real, intent(in) :: dt_diag !< The diagnostic time step [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt_diag !< The diagnostic time step [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of @@ -2257,11 +2263,6 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: S_to_bl ! The depth integrated amount of S that is detrained to the ! buffer layer [ppt H ~> ppt m or ppt kg m-2] real :: h_min_bl ! The minimum buffer layer thickness [H ~> m or kg m-2]. - real :: h_min_bl_thick ! The minimum buffer layer thickness when the - ! mixed layer is very large [H ~> m or kg m-2]. - real :: h_min_bl_frac_ml = 0.05 ! The minimum buffer layer thickness relative - ! to the total mixed layer thickness for thin - ! mixed layers [nondim], maybe 0.1/CS%nkbl. real :: h1, h2 ! Scalar variables holding the values of ! h(i,CS%nkml+1) and h(i,CS%nkml+2) [H ~> m or kg m-2]. @@ -2292,7 +2293,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers [J H2 Z m-5 ~> J m-2 or J kg2 m-8]. + ! buffer layers [kg H2 Z T-2 L-2 m-1 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. @@ -2325,26 +2326,23 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! days? real :: num_events ! The number of detrainment events over which ! to prefer merging the buffer layers. - real :: detrainment_timescale ! The typical timescale for a detrainment - ! event [s]. - real :: dPE_time_ratio ! Larger of 1 and the detrainment_timescale - ! over dt, nondimensional. + real :: dPE_time_ratio ! Larger of 1 and the detrainment timescale over dt [nondim]. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in ! [degC ppt-1] and [ppt degC-1]. real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. - real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: g_2 ! 1/2 g_Earth [L2 Z-1 T-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg L2 m-3 Z-1 T-2 ~> kg m-2 s-2]. real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z - ! divided by the time step [Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1]. + ! 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 ! respect to the coordinate potential density. 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 :: s1en ! A work variable [H2 kg m s-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [H2 L2 kg m-1 T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables. @@ -2363,22 +2361,20 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, 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 + g_2 = 0.5 * GV%g_Earth Rho0xG = GV%Rho0 * GV%g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. - h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT - dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge + dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 / dT_dS_gauge num_events = 10.0 - detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") - if (dt < detrainment_timescale) then ; dPE_time_ratio = detrainment_timescale/dt + if (dt_in_T < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (dt_in_T) else ; dPE_time_ratio = 1.0 ; endif do i=is,ie @@ -2425,7 +2421,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! Determine whether more must be detrained from the mixed layer to keep a ! minimal amount of mass in the buffer layers. In this case the 5% of the ! mixed layer thickness is hard-coded, but probably shouldn't be! - h_min_bl = MIN(h_min_bl_thick,h_min_bl_frac_ml*h(i,0)) + 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)) & @@ -2621,7 +2617,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, 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) + dPE_merge = g_2*(R0(i,kb2)-R0(i,kb1))*(h1-stays_merge)*(h2-stays_merge) endif endif @@ -2802,7 +2798,7 @@ 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 + & + 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 ) + & @@ -2898,7 +2894,7 @@ 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 + & + 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 @@ -3099,8 +3095,8 @@ 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, & - j, G, GV, CS, dRcv_dT, dRcv_dS, max_BL_det) +subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, 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. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. @@ -3113,9 +3109,9 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer [kg m-3]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. real, intent(in) :: dt_diag !< The accumulated time interval for - !! diagnostics [s]. + !! diagnostics [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea @@ -3125,6 +3121,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! Positive values go with mass gain by !! a layer. integer, intent(in) :: j !< The meridional row to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -3145,17 +3142,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. - real :: Idt ! The inverse of the timestep [s-1]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable [ppt2 m6 kg-2]. real :: Sdown, Tdown - real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 + real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time - ! step [m7 s-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [L2 Z m3 T-3 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: g_H2_2dt ! Half the gravitational acceleration times the square of the - ! conversion from H to m divided by the diagnostic time step - ! [m4 Z-1 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. + ! 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]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3165,8 +3161,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e nkmb = CS%nkml+CS%nkbl if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & "CS%nkbl must be 1 in mixedlayer_detrain_1.") - Idt = 1.0/dt - dt_Time = dt/Timescale + + dt_Time = dt_in_T / 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) @@ -3257,7 +3253,6 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e dT_dS_wt2 = CS%dT_dS_wt**2 -! dt_Time = dt/Timescale do k=nz-1,nkmb+1,-1 ; do i=is,ie if (splittable_BL(i)) then if (RcvTgt(k)<=Rcv(i,nkmb)) then @@ -3408,6 +3403,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. + real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega @@ -3494,13 +3490,29 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "buffer layers, when the detrainment is going into the "//& "lightest interior layer, nondimensional, or a negative "//& "value not to apply this limit.", units="nondim", default = -1.0) + call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_THICK", CS%Hbuffer_min, & + "The minimum buffer layer thickness when the mixed layer is very thick.", & + units="m", default=5.0, scale=GV%m_to_H) + call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_REL", CS%Hbuffer_rel_min, & + "The minimum buffer layer thickness relative to the combined mixed "//& + "land buffer ayer thicknesses when they are thin.", & + units="nondim", default=0.1/CS%nkbl) + BL_detrain_time_dflt = 4.0*3600.0 ; if (CS%nkbl==1) BL_detrain_time_dflt = 86400.0*30.0 + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + "A timescale that characterizes buffer layer detrainment events.", & + units="s", default=BL_detrain_time_dflt, scale=US%s_to_T) + call get_param(param_file, mdl, "BUFFER_SPLIT_RHO_TOL", CS%BL_split_rho_tol, & + "The fractional tolerance for matching layer target densities when splitting "//& + "layers to deal with massive interior layers that are lighter than one of the "//& + "mixed or buffer layers.", units="nondim", default=0.1) + call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean "//& "depth is less than DEPTH_LIMIT_FLUXES.", & units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) - call get_param(param_file, mdl, "OMEGA",CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + call get_param(param_file, mdl, "OMEGA", CS%omega, & + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -3524,12 +3536,12 @@ 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_m + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*US%s_to_T*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_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 "//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt, scale=US%m_to_Z) + default=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, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3569,28 +3581,34 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', '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) + Time, 'Wind-stirring source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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) + Time, 'Mean kinetic energy source of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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) + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**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) + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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) + Time, 'TKE consumed by mixing that deepens the mixed layer', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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) + Time, 'Mechanical energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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) + Time, 'Convective energy decay sink of mixed layer TKE', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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) + Time, 'Spurious source of mixed layer TKE from sigma2', & + 'm3 s-3', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**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%Z_to_m) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=US%Z_to_m) + 'W m-2', conversion=US%Z_to_m*US%L_to_m**2*US%T_to_s**3) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 5259d4ed25..96652a9f45 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -12,13 +12,18 @@ module MOM_diabatic_aux use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -use MOM_file_parser, only : get_param, log_version, param_file_type +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_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_io, only : slasher +use MOM_opacity, only : set_opacity, opacity_CS, extract_optics_slice, extract_optics_fields +use MOM_opacity, only : optics_type, optics_nbands, absorbRemainingSW, sumSWoverBands +use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type +use time_interp_external_mod, only : init_external_field, time_interp_external +use time_interp_external_mod, only : time_interp_external_init implicit none ; private @@ -26,7 +31,7 @@ module MOM_diabatic_aux public diabatic_aux_init, diabatic_aux_end public make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS -public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut, set_pen_shortwave ! 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 @@ -55,7 +60,13 @@ module MOM_diabatic_aux logical :: use_calving_heat_content !< If true, assumes that ice-ocean boundary !! has provided a calving heat content. Otherwise, calving !! is added with a temperature of the local SST. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes to determine the + !! e-folding depth of incoming shortwave radiation. + integer :: sbc_chl !< An integer handle used in time interpolation of + !! chlorophyll read from a file. + logical :: chl_from_file !< If true, chl_a is read from a file. + 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 ! Diagnostic handles @@ -64,6 +75,7 @@ module MOM_diabatic_aux integer :: id_penSW_diag = -1 !< Diagnostic ID of Penetrative shortwave heating (flux convergence) integer :: id_penSWflux_diag = -1 !< Diagnostic ID of Penetrative shortwave flux integer :: id_nonpenSW_diag = -1 !< Diagnostic ID of Non-penetrative shortwave heating + integer :: id_Chl = -1 !< Diagnostic ID of chlorophyll-A handles for opacity ! Optional diagnostic arrays real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to @@ -216,7 +228,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) !! available thermodynamic fields. type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. ! local variables real, dimension(SZI_(G)) :: & @@ -235,7 +247,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) real :: b_denom_T ! The first term in the denominators for the expressions real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 s-1 ~> m2 s-1]. + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 T-1 ~> m2 s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -381,8 +393,8 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) integer, intent(in) :: nkmb !< The number of layers in the mixed and buffer layers type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init - real, intent(in) :: dt !< The thermodyanmic time step [s]. - integer, intent(in) :: id_brine_lay !< The handle for a diagnostic + real, intent(in) :: dt !< The thermodynamic time step [s]. + integer, intent(in) :: id_brine_lay !< The handle for a diagnostic of !! which layer receivees the brine. ! local variables @@ -539,9 +551,10 @@ end subroutine triDiagTS !> This subroutine calculates u_h and v_h (velocities at thickness !! points), optionally using the entrainment amounts passed in as arguments. -subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) +subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb) 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(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -569,10 +582,10 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open ! ocean, nondimensional. - real :: s, Idenom + real :: sum_area, Idenom logical :: mix_vertically integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call cpu_clock_begin(id_clock_uv_at_h) h_neglect = GV%H_subroundoff @@ -585,20 +598,20 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) !$OMP private(s,Idenom,a_w,a_e,a_s,a_n,b_denom_1,b1,d1,c1) do j=js,je do i=is,ie - s = G%areaCu(I-1,j)+G%areaCu(I,j) - if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) - a_w(i) = G%areaCu(I-1,j)*Idenom - a_e(i) = G%areaCu(I,j)*Idenom + sum_area = G%areaCu(I-1,j) + G%areaCu(I,j) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_w(i) = G%areaCu(I-1,j) * Idenom + a_e(i) = G%areaCu(I,j) * Idenom else a_w(i) = 0.0 ; a_e(i) = 0.0 endif - s = G%areaCv(i,J-1)+G%areaCv(i,J) - if (s>0.0) then - Idenom = sqrt(0.5*G%IareaT(i,j)/s) - a_s(i) = G%areaCv(i,J-1)*Idenom - a_n(i) = G%areaCv(i,J)*Idenom + sum_area = G%areaCv(i,J-1) + G%areaCv(i,J) + if (sum_area>0.0) then + Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) + a_s(i) = G%areaCv(i,J-1) * Idenom + a_n(i) = G%areaCv(i,J) * Idenom else a_s(i) = 0.0 ; a_n(i) = 0.0 endif @@ -638,6 +651,63 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) end subroutine find_uv_at_h +subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp, tracer_flow_CSp) + type(optics_type), pointer :: optics !< An optics structure that has will contain + !! information about shortwave fluxes and absorption. + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + 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(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux + type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure of the tracer modules. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + character(len=128) :: mesg + integer :: i, j, k, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (.not.associated(optics)) return + + if (CS%var_pen_sw) then + if (CS%chl_from_file) then + ! Only the 2-d surface chlorophyll can be read in from a file. The + ! same value is assumed for all layers. + call time_interp_external(CS%sbc_chl, CS%Time, chl_2d) + do j=js,je ; do i=is,ie + if ((G%mask2dT(i,j) > 0.5) .and. (chl_2d(i,j) < 0.0)) then + write(mesg,'(" Time_interp negative chl of ",(1pe12.4)," at i,j = ",& + & 2(i3), "lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & + chl_2d(i,j), i, j, G%geoLonT(i,j), G%geoLatT(i,j) + call MOM_error(FATAL, "MOM_diabatic_aux set_pen_shortwave: "//trim(mesg)) + endif + enddo ; enddo + + if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) + + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_2d=chl_2d) + else + if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & + "The tracer flow control structure must be associated when the model sets "//& + "the chlorophyll internally in set_pen_shortwave.") + call get_chl_from_model(chl_3d, G, tracer_flow_CSp) + + if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) + + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_3d=chl_3d) + endif + else + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp) + endif + +end subroutine set_pen_shortwave + + !> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface. !> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, & @@ -667,20 +737,20 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [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 [s-2]. + 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 [m4 s-2 kg-1]. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m]. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%m_to_Z**2 * GV%g_Earth / GV%Rho0 + gE_rho0 = US%L_to_Z**2*GV%g_Earth / GV%Rho0 dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -761,7 +831,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo ! j-loop if (id_MLD > 0) call post_data(id_MLD, MLD, diagPtr) - if (id_N2 > 0) call post_data(id_N2, subMLN2 , diagPtr) + if (id_N2 > 0) call post_data(id_N2, subMLN2, diagPtr) if (id_SQ > 0) call post_data(id_SQ, MLD2, diagPtr) end subroutine diagnoseMLDbyDensityDifference @@ -769,7 +839,7 @@ end subroutine diagnoseMLDbyDensityDifference !> Update the thickness, temperature, and salinity due to thermodynamic !! boundary forcing (contained in fluxes type) applied to h, tv%T and tv%S, !! and calculate the TKE implications of this heating. -subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & +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 ) @@ -780,6 +850,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real, intent(in) :: dt !< Time-step over which forcing is applied [s] type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container + integer, intent(in) :: nsw !< The number of frequency bands of penetrating + !! shortwave radiation real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any @@ -791,7 +863,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & !! heat and freshwater fluxes is applied [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix - !! forcing through each layer [W m-2] + !! forcing through each layer [kg m-3 Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with !! potential temperature [m3 kg-1 degC-1]. @@ -799,7 +871,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 s-3 ~> m2 s-3]. + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 @@ -828,21 +900,31 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) ! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] netMassInOut_rate! netmassinout but for dt=1 [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d - real, dimension(SZI_(G), SZK_(G)) :: pen_TKE_2d, dSV_dT_2d - real, dimension(SZI_(G),SZK_(G)+1) :: netPen - real, dimension(max(optics%nbands,1),SZI_(G)) :: Pen_SW_bnd, Pen_SW_bnd_rate - !^ _rate is w/ dt=1 - real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand - real :: hGrounding(maxGroundings) + real, dimension(SZI_(G), SZK_(G)) :: & + h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] + T2d, & ! A 2-d copy of the layer temperatures [degC] + pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within + ! a layer [kg m-3 Z3 T-2 ~> J m-2] + dSV_dT_2d ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + real, dimension(SZI_(G),SZK_(G)+1) :: netPen + real, dimension(max(nsw,1),SZI_(G)) :: & + Pen_SW_bnd, & ! The penetrative shortwave heating integrated over a timestep by band + ! [degC H ~> degC m or degC kg m-2] + Pen_SW_bnd_rate ! The penetrative shortwave heating rate by band + ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(max(nsw,1),SZI_(G),SZK_(G)) :: & + opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency + ! band of shortwave radation in each layer [H-1 ~> m-1 or m2 kg-1] + real, dimension(maxGroundings) :: hGrounding real :: Temp_in, Salin_in -! real :: I_G_Earth +! real :: I_G_Earth ! The inverse of the gravitational acceleration with conversion factors [s2 m-1]. + real :: dt_in_T ! The time step converted to T units [T ~> s] real :: g_Hconv2 real :: GoRho ! g_Earth times a unit conversion factor divided by density - ! [Z m3 s-2 kg-1 ~> m4 s-2 kg-1] + ! [Z3 m T-2 kg-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy - integer :: i, j, is, ie, js, je, k, nz, n, nsw + integer :: i, j, is, ie, js, je, k, nz, n integer :: start, npts character(len=45) :: mesg @@ -852,19 +934,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (.not.associated(fluxes%sw)) return #define _OLD_ALG_ - nsw = optics%nbands + dt_in_T = dt * US%s_to_T Idt = 1.0/dt calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 -! I_G_Earth = 1.0 / GV%g_Earth - g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 +! I_G_Earth = US%Z_to_m / (US%L_T_to_m_s**2 * GV%g_Earth) + g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%g_Earth / GV%Rho0 + GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -902,10 +984,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & do k=1,nz ; do i=is,ie h2d(i,k) = h(i,j,k) T2d(i,k) = tv%T(i,j,k) - do n=1,nsw - opacityBand(n,i,k) = (1.0 / GV%m_to_H)*optics%opacity_band(n,i,j,k) - enddo enddo ; enddo + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%m_to_H)) if (calculate_energetics) then ! The partial derivatives of specific volume with temperature and @@ -922,8 +1002,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & dSV_dT(:,j,k), dSV_dS(:,j,k), is, ie-is+1, tv%eqn_of_state) do i=is,ie ; dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; enddo ! do i=is,ie -! dT_to_dPE(i,k) = I_G_Earth * US%Z_to_m * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) -! dS_to_dPE(i,k) = I_G_Earth * US%Z_to_m * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) +! dT_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dT(i,j,k) +! dS_to_dPE(i,k) = I_G_Earth * d_pres(i) * p_lay(i) * dSV_dS(i,j,k) ! enddo enddo pen_TKE_2d(:,:) = 0.0 @@ -977,8 +1057,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW, & - net_Heat_rate=netheat_rate,net_salt_rate=netsalt_rate, & - netmassinout_rate=netmassinout_rate,pen_sw_bnd_rate=pen_sw_bnd_rate) + net_Heat_rate=netheat_rate, net_salt_rate=netsalt_rate, & + netmassinout_rate=netmassinout_rate, pen_sw_bnd_rate=pen_sw_bnd_rate) else call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -1049,7 +1129,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! 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) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa + RivermixConst = -0.5*(CS%rivermix_depth*dt)*(US%m_to_Z**3 * US%T_to_s**2) * GV%Z_to_H*GV%H_to_Pa cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) @@ -1061,7 +1141,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (h2d(i,k) > 0.0) then if (calculate_energetics .and. (dThickness > 0.)) then ! Calculate the energy required to mix the newly added water over - ! the topmost grid cell. ###CHECK THE SIGNS!!! + ! the topmost grid cell. cTKE(i,j,k) = cTKE(i,j,k) + 0.5*g_Hconv2*(hOld*dThickness) * & ((T2d(i,k) - Temp_in) * dSV_dT(i,j,k) + (tv%S(i,j,k) - Salin_in) * dSV_dS(i,j,k)) endif @@ -1123,14 +1203,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (h2d(i,k) > 0.) then if (calculate_energetics) then - ! 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. Note that dThickness is always <= 0. ###CHECK THE SIGNS!!! + ! 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. Note that dThickness is always <= 0 here, and that + ! negative cTKE is a deficit that will need to be filled later. cTKE(i,j,k) = cTKE(i,j,k) - (0.5*h2d(i,k)*g_Hconv2) * & - ((dTemp - dthickness*T2d(i,k)) * dSV_dT(i,j,k) + & - (dSalt - dthickness*tv%S(i,j,k)) * dSV_dS(i,j,k)) + ((dTemp - dthickness*T2d(i,k)) * dSV_dT(i,j,k) + & + (dSalt - dthickness*tv%S(i,j,k)) * dSV_dS(i,j,k)) endif Ithickness = 1.0/h2d(i,k) ! Inverse of new thickness T2d(i,k) = (hOld*T2d(i,k) + dTemp)*Ithickness @@ -1189,19 +1269,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & CS%penSWflux_diag(i,j,k) = 0.0 enddo ; enddo k=nz+1 ; do i=is,ie - CS%penSWflux_diag(i,j,k) = 0.0 + CS%penSWflux_diag(i,j,k) = 0.0 enddo endif if (calculate_energetics) then - call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd, TKE=pen_TKE_2d, dSV_dT=dSV_dT_2d) k = 1 ! For setting break-points. do k=1,nz ; do i=is,ie cTKE(i,j,k) = cTKE(i,j,k) + pen_TKE_2d(i,k) enddo ; enddo else - call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd) endif @@ -1254,8 +1334,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netPen(:,:) = 0.0 ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, h2d(:,:), optics%opacity_band(:,:,j,:), nsw, j, dt, & - H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) + call sumSWoverBands(G, GV, US, h2d(:,:), optics_nbands(optics), optics, j, dt_in_T, & + H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, & dRhodT, dRhodS, start, npts, tv%eqn_of_state) @@ -1265,9 +1345,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! 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 * US%m_to_Z**2 * ( & - dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & - dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%T_to_s * & + (dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & + dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo endif @@ -1300,7 +1380,7 @@ end subroutine applyBoundaryFluxesInOut !> This subroutine initializes the parameters and control structure of the diabatic_aux module. subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgorithm, use_ePBL) - type(time_type), intent(in) :: Time !< The current model time + type(time_type), target, 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 @@ -1318,6 +1398,12 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori #include "version_variable.h" character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=48) :: thickness_units + character(len=200) :: inputdir ! The directory where NetCDF input files + character(len=240) :: chl_filename ! A file from which chl_a concentrations are to be read. + character(len=128) :: chl_file ! Data containing chl_a concentrations. Used + ! when var_pen_sw is defined and reading from file. + character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. + logical :: use_temperature ! True if thermodynamics are enabled. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -1331,11 +1417,16 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori endif CS%diag => diag + CS%Time => Time ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for auxiliary diabatic processes.") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & + "If true, temperature and salinity are used as state "//& + "variables.", default=.true.) + call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any "//& "overlying layers down to the freezing point, thereby "//& @@ -1417,6 +1508,35 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori endif endif + if (use_temperature) then + call get_param(param_file, mdl, "VAR_PEN_SW", CS%var_pen_sw, & + "If true, use one of the CHL_A schemes specified by "//& + "OPACITY_SCHEME to determine the e-folding depth of "//& + "incoming short wave radiation.", default=.false.) + if (CS%var_pen_sw) then + + call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & + "If true, chl_a is read from a file.", default=.true.) + if (CS%chl_from_file) then + call time_interp_external_init() + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "CHL_FILE", chl_file, & + "CHL_FILE is the file containing chl_a concentrations in "//& + "the variable CHL_A. It is used when VAR_PEN_SW and "//& + "CHL_FROM_FILE are true.", fail_if_missing=.true.) + chl_filename = trim(slasher(inputdir))//trim(chl_file) + call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", chl_filename) + call get_param(param_file, mdl, "CHL_VARNAME", chl_varname, & + "Name of CHL_A variable in CHL_FILE.", default='CHL_A') + CS%sbc_chl = init_external_field(chl_filename, trim(chl_varname), domain=G%Domain%mpp_domain) + endif + + CS%id_chl = register_diag_field('ocean_model', 'Chl_opac', diag%axesT1, Time, & + 'Surface chlorophyll A concentration used to find opacity', 'mg m-3') + endif + endif + id_clock_uv_at_h = cpu_clock_id('(Ocean find_uv_at_h)', grain=CLOCK_ROUTINE) id_clock_frazil = cpu_clock_id('(Ocean frazil)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 25d4eadb7d..e6f644d210 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -14,6 +14,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +use MOM_diabatic_aux, only : set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging @@ -51,12 +52,12 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln -use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS +use MOM_opacity, only : opacity_init, opacity_end, opacity_CS +use MOM_opacity, only : absorbRemainingSW, optics_type, optics_nbands use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_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 -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) @@ -67,7 +68,6 @@ module MOM_diabatic_driver use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speeds -use time_manager_mod, only : increment_time ! for testing itides (BDM) use MOM_wave_interface, only : wave_parameters_CS @@ -81,7 +81,7 @@ module MOM_diabatic_driver public extract_diabatic_member public adiabatic public adiabatic_driver_init -public legacy_diabatic +! public legacy_diabatic ! 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 @@ -90,6 +90,10 @@ module MOM_diabatic_driver !> Control structure for this module type, public:: diabatic_CS; private + + logical :: use_legacy_diabatic !< If true (default), use the a legacy version of the diabatic + !! algorithm. This is temporary and is needed to avoid change + !! in answers. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary @@ -116,20 +120,8 @@ module MOM_diabatic_driver !! other diffusivities. Otherwise, the larger of kappa- !! shear and ePBL diffusivities are used. integer :: nMode = 1 !< Number of baroclinic modes to consider - logical :: int_tide_source_test !< If true, apply an arbitrary generation site - !! for internal tide testing (BDM) - real :: int_tide_source_x !< X Location of generation site - !! for internal tide for testing (BDM) - real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) - integer :: tlen_days !< Time interval from start for adding wave source - !! for testing internal tides (BDM) - logical :: uniform_cg !< If true, set cg = cg_test everywhere - !! for testing internal tides (BDM) - real :: cg_test !< Uniform group velocity of internal tide - !! for testing internal tides (BDM) - type(time_type) :: time_max_source !< For use in testing internal tides (BDM) - type(time_type) :: time_end !< For use in testing internal tides (BDM) + real :: uniform_test_cg !< Uniform group velocity of internal tide + !! for testing internal tides [L T-1 ~> m s-1] logical :: useALEalgorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical !! passed by argument to diabatic_driver_init. @@ -151,11 +143,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! [Z2 s-1 ~> m2 s-1]. The entrainment at the bottom is at + !! [Z2 T-1 ~> m2 s-1]. 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 s-1 ~> m2 s-1]. + !! near the bottom [Z2 T-1 ~> m2 s-1]. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied [m]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -174,7 +166,6 @@ module MOM_diabatic_driver real :: MLDdensityDifference !< Density difference used to determine MLD_user real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the !! average stratification at the base of the mixed layer [Z ~> m]. - integer :: nsw !< SW_NBANDS !>@{ Diagnostic IDs integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) @@ -214,66 +205,1039 @@ module MOM_diabatic_driver integer :: id_frazil_heat_tend_2d = -1 !!@} - logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics - logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics - logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics - real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil - real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil + logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics + logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics + logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics + real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil + real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil + + type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module + type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module + type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module + type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module + type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module + type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module + type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module + type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module + type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module + type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module + type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module + type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module + type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module + type(optics_type), pointer :: optics => NULL() !< Control structure for a child module + type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module + type(CVMix_conv_cs), pointer :: CVMix_conv_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(group_pass_type) :: pass_hold_eb_ea !< For group halo pass + type(group_pass_type) :: pass_Kv !< For group halo pass + type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm + ! Data arrays for communicating between components + real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] + real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] + real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] + real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] + real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] + + type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) +end type diabatic_CS + +! clock ids +integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity +integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge +integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap +integer :: id_clock_kpp + +contains + +!> This subroutine imposes the diapycnal mass fluxes and the +!! accompanying diapycnal advection of momentum and tracers. +subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + eta ! Interface heights before diapycnal mixing [m]. + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn_IGW ! baroclinic internal gravity wave speeds + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) + real :: dt_in_T ! The time step converted to T units [T ~> s] + integer :: i, j, k, m, is, ie, js, je, nz + logical :: showCallTree ! If true, show the call tree + + if (G%ke == 1) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a zero length timestep.") + if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a negative timestep.") + + showCallTree = callTree_showQuery() + + ! Offer diagnostics of various state varables at the start of diabatic + ! these are mostly for debugging purposes. + if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) + if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) + if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) + if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) + if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) + if (CS%id_e_predia > 0) then + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) + call post_data(CS%id_e_predia, eta, CS%diag) + endif + + dt_in_T = dt * US%s_to_T + if (CS%debug) then + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, US, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) + endif + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G, GV, US) + + if (CS%debug_energy_req) & + call diapyc_energy_req_test(h, dt_in_T, 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) + call cpu_clock_end(id_clock_set_diffusivity) + + ! Frazil formation keeps the temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + ! For frazil diagnostic, the first call covers the first half of the time step + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) + endif + if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) + endif + call disable_averaging(CS%diag) + endif ! associated(tv%T) .AND. associated(tv%frazil) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G, GV, US) + + + if (CS%use_int_tides) then + ! This block provides an interface for the unresolved low-mode internal tide module (BDM). + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & + CS%int_tide_input_CSp) + cn_IGW(:,:,:) = 0.0 + if (CS%uniform_test_cg > 0.0) then + do m=1,CS%nMode ; cn_IGW(:,:,m) = CS%uniform_test_cg ; enddo + else + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, full_halos=.true.) + endif + + call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") + endif ! end CS%use_int_tides + + if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + elseif (CS%useALEalgorithm) then + call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + else + call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + endif + + + call cpu_clock_begin(id_clock_pass) + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) + + call disable_averaging(CS%diag) + ! Frazil formation keeps temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + call enable_averaging(0.5*dt, Time_end, CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) + endif + + if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G, GV, US) + call disable_averaging(CS%diag) + + endif ! endif for frazil + + + ! Diagnose mixed layer depths. + call enable_averaging(dt, Time_end, CS%diag) + if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) + endif + if (CS%use_int_tides) then + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn_IGW(:,:,1),CS%diag) + do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m), cn_IGW(:,:,m), CS%diag) ; enddo + endif + call disable_averaging(CS%diag) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) + +end subroutine diabatic + + + +!> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use +!! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + ea_s, & ! amount of fluid entrained from the layer above within + ! one time step [H ~> m or kg m-2] + eb_s, & ! amount of fluid entrained from the layer below within + ! one time step [H ~> m or kg m-2] + ea_t, & ! amount of fluid entrained from the layer above within + ! one time step [H ~> m or kg m-2] + eb_t, & ! 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] + h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] + hold, & ! layer thickness before diapycnal entrainment, and later + ! the initial layer thicknesses (if a mixed layer is used), + ! [H ~> m or kg m-2] + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. + u_h, & ! zonal and meridional velocities at thickness points after + v_h ! entrainment [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)) :: & + Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL + real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn + + real :: net_ent ! The net of ea-eb at an interface. + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and + ebtr ! eb in that they tend to homogenize tracers in massless layers + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & + 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_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] + + logical :: in_boundary(SZI_(G)) ! 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 :: b_denom_1 ! The first term in the denominator of b1 + ! [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 :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] + 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] + real :: hval ! hval is 2*h at velocity grid points [H ~> m or kg m-2] + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness [H ~> m or kg m-2] + 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 :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the + real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. + + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: Idt ! The inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] + + integer :: dir_flag ! An integer encoding the directions in which to do halo updates. + logical :: showCallTree ! If true, show the call tree + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo + + integer :: ig, jg ! global indices for testing testing itide point source (BDM) + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("diabatic_ALE_legacy(), MOM_diabatic_driver.F90") +! if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") + + dt_in_T = dt * US%s_to_T + + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep + call enable_averaging(dt, Time_end, CS%diag) + + if (CS%use_geothermal) then + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo + h_orig(i,j,k) = h(i,j,k) ; eatr(i,j,k) = 0.0 ; ebtr(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + + if (CS%use_geothermal) then + call cpu_clock_begin(id_clock_geothermal) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call cpu_clock_end(id_clock_geothermal) + if (showCallTree) call callTree_waypoint("geothermal (diabatic)") + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) + endif + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! Set_pen_shortwave estimates the optical properties of the water column. + ! It will need to be modified later to include information about the + ! biological properties and layer thicknesses. + if (associated(CS%optics)) & + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) + + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then + if (CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) + if (CS%debug) then + call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) + endif + else + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) + endif + if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") + endif + + call cpu_clock_begin(id_clock_set_diffusivity) + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) + call cpu_clock_end(id_clock_set_diffusivity) + if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + + ! Set diffusivities for heat and salt separately + + if (.not.CS%use_legacy_diabatic .or. CS%useKPP) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) + enddo ; enddo ; enddo + ! Add contribution from double diffusion + if (associated(visc%Kd_extra_S)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + enddo ; enddo ; enddo + endif + endif + + if (CS%debug) then + 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) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", 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=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) + endif + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! total vertical viscosity in the interior is represented via visc%Kv_shear + if (.not.CS%use_legacy_diabatic) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) + enddo ; enddo ; enddo + endif + + ! KPP needs the surface buoyancy flux but does not update state variables. + ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. + ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux + ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! 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. + + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, 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) + + if (associated(Hml)) then + !$OMP parallel default(shared) + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + !$OMP end parallel + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy KPP's BLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + endif + + if (CS%use_legacy_diabatic .and. .not.CS%KPPisPassive) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) + enddo ; enddo ; enddo + endif + endif ! not passive + + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") + if (CS%debug) then + 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) + 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) + endif + + endif ! endif for KPP + + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + if (CS%debug) then + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) + endif + ! Apply non-local transport of heat and salt + ! Changes: tv%T, tv%S + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) + + if (CS%debug) then + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + endif + endif ! endif for KPP + + ! This is the "old" method for applying differential diffusion. + ! Changes: tv%T, tv%S + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. & + (CS%use_legacy_diabatic .or. .not.CS%use_CVMix_ddiff)) then + + call cpu_clock_begin(id_clock_differential_diff) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, 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) + + ! increment heat and salt diffusivity. + ! CS%useKPP==.true. already has extra_T and extra_S included + if (.not. CS%useKPP) then + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + enddo ; enddo ; enddo + endif + + endif + + ! Calculate vertical mixing due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) + ! Increment vertical diffusion and viscosity due to convection + if (CS%use_legacy_diabatic) then + !$OMP parallel do default(shared) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + enddo ; enddo ; enddo + else + !$OMP parallel do default(shared) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + if (CS%useKPP) then + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + else + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + endif + enddo ; enddo ; enddo + endif + endif + + ! This block sets ea, eb from h and Kd_int. + if (CS%use_legacy_diabatic) then + do j=js,je ; do i=is,ie + ea_s(i,j,1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) + eb_s(i,j,k-1) = ea_s(i,j,k) + ea_t(i,j,k-1) = ea_s(i,j,k-1) ; eb_t(i,j,k-1) = eb_s(i,j,k-1) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_s(i,j,nz) = 0.0 + ea_t(i,j,nz) = ea_s(i,j,nz) ; eb_t(i,j,nz) = eb_s(i,j,nz) + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + endif + + if (CS%debug) then + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) + call hchksum(ea_s, "after calc_entrain ea_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after calc_entrain eb_s", G%HI, haloshift=0, scale=GV%H_to_m) + endif + + ! Save fields before boundary forcing is applied for tendency diagnostics + if (CS%boundary_forcing_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_diag(i,j,k) = h(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Apply forcing + call cpu_clock_begin(id_clock_remap) + + ! Changes made to following fields: h, tv%T and tv%S. + do k=1,nz ; do j=js,je ; do i=is,ie + h_prebound(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + if (CS%use_energetic_PBL) then + + 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) + + if (CS%debug) then + call hchksum(ea_t, "after applyBoundaryFluxes ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after applyBoundaryFluxes eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after applyBoundaryFluxes ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after applyBoundaryFluxes eb_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + endif + + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + + if (associated(Hml)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy ePBL's MLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + elseif (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call pass_var(visc%MLD, G%domain, halo=1) + endif + + ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. + do K=2,nz ; do j=js,je ; do i=is,ie + !### These expressions assume a Prandtl number of 1. + if (CS%ePBL_is_additive) then + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + else + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + endif + + if (CS%use_legacy_diabatic) then + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int + ea_s(i,j,k) = ea_s(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + else + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_add_here + endif + + enddo ; enddo ; enddo + + if (CS%debug) then + call hchksum(ea_t, "after ePBL ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after ePBL eb_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) + 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) + + endif ! endif for CS%use_energetic_PBL + + ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards + if (CS%boundary_forcing_tendency_diag) then + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) + endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) + call cpu_clock_end(id_clock_remap) + if (CS%debug) then + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) + + ! Update h according to divergence of the difference between + ! ea and eb. We keep a record of the original h in hold. + ! In the following, the checks for negative values are to guard against + ! instances where entrainment drives a layer to negative thickness. + !### This code may be unnecessary, but the negative-thickness checks do appear to change + ! answers slightly in some cases. + if (CS%use_legacy_diabatic) then + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + ! Does nothing with ALE: h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + ! Does nothing with ALE: h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) + if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H + if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + ! Does nothing with ALE: h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & + ! (eb_s(i,j,k) - ea_s(i,j,k+1))) + if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H + enddo ; enddo + enddo + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + endif + + if (CS%debug) then + call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) + call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after negative check ", tv, G) + endif + if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) + + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then + + if (CS%debug) then + call hchksum(ea_t, "before triDiagTS ea_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "before triDiagTS eb_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "before triDiagTS ea_s ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "before triDiagTS eb_s ",G%HI,haloshift=0, scale=GV%H_to_m) + endif + + call cpu_clock_begin(id_clock_tridiag) + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + if (CS%diabatic_diff_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + if (CS%use_legacy_diabatic) then + ! Changes T and S via the tridiagonal solver; no change to h + do k=1,nz ; do j=js,je ; do i=is,ie + ea_t(i,j,k) = ea_s(i,j,k) ; eb_t(i,j,k) = eb_s(i,j,k) + enddo ; enddo ; enddo + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea_s, eb_s, tv%T, tv%S) + endif + + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will (not?) have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif + else + ! Set ea_t=eb_t based on Kd_heat and ea_s=eb_s based on Kd_salt on interfaces for use in the tri-diagonal solver. + + do j=js,je ; do i=is,ie + ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. + enddo ; enddo + + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) + eb_t(i,j,k-1) = ea_t(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) + eb_s(i,j,k-1) = ea_s(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& + "and Kd_salt (diabatic)") + + ! Changes T and S via the tridiagonal solver; no change to h + call tracer_vertdiff(h, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(h, ea_s, eb_s, dt, tv%S, G, GV) + + ! In ALE-mode, layer thicknesses do not change. Therefore, we can use h below + if (CS%diabatic_diff_tendency_diag) & + call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, CS) + endif + + call cpu_clock_end(id_clock_tridiag) + + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") + + endif ! endif corresponding to if (associated(tv%T)) + + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) + + if (CS%debug) then + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) + call MOM_thermovar_chksum("after mixed layer ", tv, G) + endif + + ! Whenever thickness changes let the diag manager know, as the + ! target grids for vertical remapping may need to be regenerated. + if (CS%id_dudt_dia > 0 .or. CS%id_dvdt_dia > 0) & + ! Remapped d[uv]dt_dia require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) + call diag_update_remap_grids(CS%diag) + + ! diagnostics + Idt = 1.0 / dt + if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then + do j=js,je ; do i=is,ie + Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 + Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Tdif_flx(i,j,K) = (Idt * 0.5*(ea_t(i,j,k) + eb_t(i,j,k-1))) * & + (tv%T(i,j,k-1) - tv%T(i,j,k)) + Tadv_flx(i,j,K) = (Idt * (ea_t(i,j,k) - eb_t(i,j,k-1))) * & + 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) + enddo ; enddo ; enddo + endif + if ((CS%id_Sdif > 0) .or. (CS%id_Sadv > 0)) then + do j=js,je ; do i=is,ie + Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 + Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Sdif_flx(i,j,K) = (Idt * 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1))) * & + (tv%S(i,j,k-1) - tv%S(i,j,k)) + Sadv_flx(i,j,K) = (Idt * (ea_s(i,j,k) - eb_s(i,j,k-1))) * & + 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) + enddo ; enddo ; enddo + endif + + ! mixing of passive tracers from massless boundary layers to interior + call cpu_clock_begin(id_clock_tracers) + + if (CS%mix_boundary_tracers) then + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) + !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) + do j=js,je + do i=is,ie + ebtr(i,j,nz) = eb_s(i,j,nz) + htot(i) = 0.0 + in_boundary(i) = (G%mask2dT(i,j) > 0.0) + enddo + do k=nz,2,-1 ; do i=is,ie + if (in_boundary(i)) then + htot(i) = htot(i) + h(i,j,k) + ! If diapycnal mixing has been suppressed because this is a massless + ! layer near the bottom, add some mixing of tracers between these + ! layers. This flux is based on the harmonic mean of the two + ! thicknesses, as this corresponds pretty closely (to within + ! differences in the density jumps between layers) with what is done + ! 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_in_T * 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)) - & + 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) + if (htot(i) < Tr_ea_BBL) then + add_ent = max(0.0, add_ent, & + (Tr_ea_BBL - htot(i)) - min(ea_s(i,j,k),eb_s(i,j,k-1))) + elseif (add_ent < 0.0) then + add_ent = 0.0 ; in_boundary(i) = .false. + endif + + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent + else + ebtr(i,j,k-1) = eb_s(i,j,k-1) ; eatr(i,j,k) = ea_s(i,j,k) + endif + + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then + if (CS%use_legacy_diabatic) then + add_ent = ((dt_in_T * visc%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) + else + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & + h_neglect) + endif + ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent + eatr(i,j,k) = eatr(i,j,k) + add_ent + endif ; endif + enddo ; enddo + do i=is,ie ; eatr(i,j,1) = ea_s(i,j,1) ; enddo + + enddo + + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + ! so hold should be h_orig + call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + + elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers + + do j=js,je ; do i=is,ie + ebtr(i,j,nz) = eb_s(i,j,nz) ; eatr(i,j,1) = ea_s(i,j,1) + enddo ; enddo + !$OMP parallel do default(shared) private(add_ent) + do k=nz,2,-1 ; do j=js,je ; do i=is,ie + if (visc%Kd_extra_S(i,j,k) > 0.0) then + if (CS%use_legacy_diabatic) then + add_ent = ((dt_in_T * visc%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) + else + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & + h_neglect) + endif + else + add_ent = 0.0 + endif + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent + enddo ; enddo ; enddo + + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug,& + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + endif ! (CS%mix_boundary_tracers) + + call cpu_clock_end(id_clock_tracers) + + ! Apply ALE sponge + if (CS%use_sponge) then + call cpu_clock_begin(id_clock_sponge) + if (associated(CS%ALE_sponge_CSp)) then + call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + endif + + call cpu_clock_end(id_clock_sponge) + if (CS%debug) then + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) + call MOM_thermovar_chksum("apply_sponge ", tv, G) + endif + endif ! CS%use_sponge + + call disable_averaging(CS%diag) + ! Diagnose the diapycnal diffusivities and other related quantities. + call enable_averaging(dt, Time_end, CS%diag) + + if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, 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 > 0) call post_data(CS%id_ea, ea_s, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb_s, CS%diag) + if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ea_t, CS%diag) + if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, eb_t, CS%diag) + if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ea_s, CS%diag) + if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, eb_s, CS%diag) - type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module - type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module - type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module - type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module - type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module - type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module - type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module - type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module - type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module - type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module - type(optics_type), pointer :: optics => NULL() !< Control structure for a child module - type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module - type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module - type(CVMix_conv_cs), pointer :: CVMix_conv_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 + if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) + if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) + if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass - type(group_pass_type) :: pass_Kv !< For group halo pass - type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm - ! Data arrays for communicating between components - real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [m2 s-3] - real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] + if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) + if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) + if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) + if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) -end type diabatic_CS + call disable_averaging(CS%diag) -! clock ids -integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity -integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge -integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp + if (showCallTree) call callTree_leave("diabatic_ALE_legacy()") + +end subroutine diabatic_ALE_legacy -contains !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< mixed layer depth [m] + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -302,55 +1266,36 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] - dSV_dT, & ! The partial derivatives of specific volume with temperature - dSV_dS, & ! and salinity in [m3 kg-1 degC-1] and [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [J/m^2]. + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux [Z2 s-3 ~> m2 s-3], used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & - ! These are targets so that the space can be shared with eaml & ebml. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. + 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_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] - ! The following 5 variables are only used with a bulk mixed layer. - real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes [H ~> m or kg m-2] - ebml ! [H ~> m or kg m-2]. These will be - ! pointers to eatr and ebtr so as to reuse the memory as - ! the arrays are not needed at the same time. - - integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser - ! than the buffer layer [nondim] - - real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential - ! density which defines the coordinate - ! variable, set to P_Ref [Pa]. - logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that ! the no-flux boundary conditions have not restricted @@ -376,16 +1321,15 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] - real :: dt_mix ! amount of time over which to apply mixing [s] - real :: Idt ! inverse time step [s-1] + real :: Idt ! The inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -393,186 +1337,79 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") if (.not. (CS%useALEalgorithm)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "The ALE algorithm must be enabled when using MOM_diabatic_driver.") - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif - - - ! set equivalence between the same bits of memory for these arrays - eaml => eatr ; ebml => ebtr - - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "diabatic was called with a negative timestep.") - Idt = 1.0 / dt - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - 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) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif !associated(tv%T) .AND. associated(tv%frazil) + dt_in_T = dt * US%s_to_T ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + if (CS%use_geothermal) then halo = CS%halo_TS_diff !$OMP parallel do default(shared) do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo - h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + h_orig(i,j,k) = h(i,j,k) ; eatr(i,j,k) = 0.0 ; ebtr(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) - if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + if (CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eatr, ebtr) if (CS%debug) then - call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) - call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & - CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & - CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif ! end CS%use_int_tides - call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US,CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + if (CS%debug) then + 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) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + ! Set diffusivities for heat and salt separately !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then @@ -589,11 +1426,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + 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) endif if (CS%useKPP) then @@ -616,7 +1450,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & fluxes%ustar, 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) + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then !$OMP parallel default(shared) @@ -630,11 +1464,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + 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) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + 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) endif endif ! endif for KPP @@ -643,10 +1477,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S @@ -654,10 +1488,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") - if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif @@ -665,15 +1499,15 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! This is the "old" method for applying differential diffusion. ! Changes: tv%T, tv%S - if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. .not. & - CS%use_CVMix_ddiff) then + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. & + (.not.CS%use_CVMix_ddiff)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, 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) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included @@ -692,13 +1526,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) endif enddo ; enddo ; enddo endif @@ -717,13 +1551,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Changes made to following fields: h, tv%T and tv%S. do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) + h_prebound(i,j,k) = h(i,j,k) enddo ; enddo ; enddo if (CS%use_energetic_PBL) then skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + 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) if (CS%debug) then @@ -736,9 +1570,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) endif - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -752,7 +1586,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie - !### These expressesions assume a Prandtl number of 1. + !### These expressions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) @@ -771,12 +1605,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & CS%evap_CFL_limit, CS%minimum_forcing_depth) endif ! endif for CS%use_energetic_PBL @@ -794,13 +1628,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G, GV, US) if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") - if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! calculate change in temperature & salinity due to dia-coordinate surface diffusion if (associated(tv%T)) then @@ -839,9 +1673,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -882,10 +1716,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) endif @@ -894,6 +1728,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -925,7 +1760,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -942,9 +1777,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! 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, + ! 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) * & + add_ent = ((dt_in_T * 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)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -962,7 +1797,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -988,7 +1823,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1003,29 +1838,26 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%optics, CS%tracer_flow_CSp, CS%debug,& evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) - else ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) - endif ! (CS%mix_boundary_tracers) call cpu_clock_end(id_clock_tracers) - ! sponges + ! Apply ALE sponge if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -1038,42 +1870,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call create_group_pass(CS%pass_hold_eb_ea, ea_t, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea_s, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear and visc%Kv_slow are not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + ! visc%Kv_slow is not in the group pass because it has larger vertical extent. if (associated(visc%Kv_slow)) & call pass_var(visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass) call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -1091,48 +1893,30 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("diabatic_ALE()") -end subroutine diabatic +end subroutine diabatic_ALE !> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers !! using the original MOM6 algorithms. -subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -1152,27 +1936,22 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step [H ~> m or kg m-2] Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] - h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [J m-2]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment [m s-1] - - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - + v_h ! entrainment [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux [m2 s-3], used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. @@ -1180,14 +1959,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries [H ~> m or kg m-2] + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. + 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_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] @@ -1195,9 +1973,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, - ebml ! [H ~> m or kg m-2]. These will be - ! pointers to eatr and ebtr so as to reuse the memory as + eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. + ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. + ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser @@ -1231,95 +2009,35 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. - real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2]. - real :: dt_mix ! amount of time over which to apply mixing [s] - real :: Idt ! inverse time step [s-1] + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] + real :: Idt ! The inverse time step [s-1] + real :: Idt_accel ! The inverse time step times rescaling factors [T-1 ~> s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo - integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 - Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - - - if (nz == 1) return - showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") - - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif - - ! set equivalence between the same bits of memory for these arrays - eaml => eatr ; ebml => ebtr - - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a negative timestep.") - Idt = 1.0 / dt - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + integer :: ig, jg ! global indices for testing testing itide point source (BDM) + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("layered_diabatic(), MOM_diabatic_driver.F90") - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + ! set equivalence between the same bits of memory for these arrays + eaml => eatr ; ebml => ebtr + dt_in_T = dt * US%s_to_T - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then halo = CS%halo_TS_diff @@ -1334,23 +2052,21 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") - if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G, GV, US) endif ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%bulkmixedlayer) then - if (CS%debug) then - call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) - endif + if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) if (CS%ML_mix_first > 0.0) then ! This subroutine @@ -1360,22 +2076,22 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Monin-Obukhov depth or minimum mixed layer depth. ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T*CS%ML_mix_first, & eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & dt*CS%ML_mix_first, CS%id_brine_lay) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) endif ! Keep salinity from falling below a small but positive threshold. @@ -1388,97 +2104,48 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) call cpu_clock_end(id_clock_mixedlayer) if (CS%debug) then - call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("After mixedlayer", fluxes, G, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif endif - if (CS%debug) then - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) - endif + if (CS%debug) & + call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, US, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eaml, ebml) if (CS%debug) then call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) endif else - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) endif if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif - call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? - ! And sets visc%Kv_shear + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear and visc%Kv_shear if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & - CS%set_diff_CSp, Kd_lay, Kd_int) + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, & + visc, dt_in_T, G, GV, US, CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + 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) - 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=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) endif @@ -1493,11 +2160,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - !$OMP parallel do default(shared) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) - enddo ; enddo ; enddo + ! Set diffusivities for heat and salt separately + + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) + enddo ; enddo ; enddo + ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -1527,18 +2197,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = US%T_to_s * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1546,13 +2216,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then - call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + 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) - 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=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) endif endif ! endif for KPP @@ -1561,24 +2229,19 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - endif if (CS%useKPP) then - call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S @@ -1586,29 +2249,29 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") - if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) if (CS%debug) then - call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif - endif ! endif for KPP ! Differential diffusion done here. ! Changes: tv%T, tv%S if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call cpu_clock_begin(id_clock_differential_diff) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, 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) + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G, GV, US) ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then + !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) @@ -1618,44 +2281,22 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif ! This block sets ea, eb from Kd or Kd_int. - ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for - ! use in the tri-diagonal solver. ! Otherwise, call entrainment_diffusive() which sets ea and eb ! based on KD and target densities (ie. does remapping as well). - if (CS%useALEalgorithm) then - - do j=js,je ; do i=is,ie - ea(i,j,1) = 0. - enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & -!$OMP private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * (US%s_to_T * Kd_int(i,j,K)) - eb(i,j,k-1) = ea(i,j,k) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") - - else ! .not. CS%useALEalgorithm - ! When not using ALE, calculate layer entrainments/detrainments from - ! diffusivities and differences between layer and target densities - call cpu_clock_begin(id_clock_entrain) - ! Calculate appropriately limited diapycnal mass fluxes to account - ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) - call cpu_clock_end(id_clock_entrain) - if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") - - endif ! endif for (CS%useALEalgorithm) + ! When not using ALE, calculate layer entrainments/detrainments from + ! diffusivities and differences between layer and target densities + call cpu_clock_begin(id_clock_entrain) + ! Calculate appropriately limited diapycnal mass fluxes to account + ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb + call Entrainment_diffusive(h, tv, fluxes, dt_in_T, G, GV, US, CS%entrain_diffusive_CSp, & + ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) + call cpu_clock_end(id_clock_entrain) + if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G) - call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -1669,97 +2310,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo ; enddo ; enddo endif - ! Apply forcing when using the ALE algorithm - if (CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - - ! Changes made to following fields: h, tv%T and tv%S. - - do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - if (CS%use_energetic_PBL) then - - skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) - - if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) - endif - - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) - endif - - ! Augment the diffusivities 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 - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) - else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), 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) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * Kd_add_here - - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s * Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s * Kd_int(i,j,K) - - enddo ; enddo ; enddo - - if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) - endif - - else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) - - endif ! endif for CS%use_energetic_PBL - - ! diagnose the tendencies due to boundary forcing - ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme - ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards - if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) - if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) - endif - ! Boundary fluxes may have changed T, S, and h - call diag_update_remap_grids(CS%diag) - - call cpu_clock_end(id_clock_remap) - if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) - endif - if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) - - endif ! endif for (CS%useALEalgorithm) - ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. ! In the following, the checks for negative values are to guard @@ -1795,12 +2345,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call diag_update_remap_grids(CS%diag) if (CS%debug) then - call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after negative check ", tv, G) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") - if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) ! Here, T and S are updated according to ea and eb. ! If using the bulk mixed layer, T and S are also updated @@ -1892,7 +2442,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_end(id_clock_tridiag) endif ! endif for associated(T) - if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G, GV, US) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then ! The mixed layer code has already been called, but there is some needed @@ -1918,18 +2468,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! (4) Uses any remaining TKE to drive mixed layer entrainment. ! (5) Possibly splits the buffer layer into two isopycnal layers. - call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) - if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) + call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, US, ea, eb) + if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, US, haloshift=0) - dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) + dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, US%T_to_s*dt_mix, & CS%id_brine_lay) ! Keep salinity from falling below a small but positive threshold. @@ -1943,7 +2493,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_end(id_clock_mixedlayer) if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G, GV, US) endif else ! following block for when NOT using BULKMIXEDLAYER @@ -1975,16 +2525,15 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Changes T and S via the tridiagonal solver; no change to h if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) else call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) endif ! diagnose temperature, salinity, heat, and salt tendencies ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed - ! In either case, tendencies should be posted on hold + ! the bulk mixed layer scheme, so tendencies should be posted on hold. if (CS%diabatic_diff_tendency_diag) then call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) @@ -1994,24 +2543,22 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") endif ! endif corresponding to if (associated(tv%T)) - if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G, GV, US) endif ! endif for the BULKMIXEDLAYER block if (CS%debug) then - call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G) call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif - if (.not. CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) - call cpu_clock_end(id_clock_remap) - if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) - endif + call cpu_clock_begin(id_clock_remap) + call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) + call cpu_clock_end(id_clock_remap) + if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G, GV, US) ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. @@ -2021,6 +2568,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -2051,7 +2599,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2070,7 +2618,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! 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) * & + add_ent = ((dt_in_T * 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)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2087,7 +2635,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%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) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2098,17 +2646,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -2118,7 +2657,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%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) else @@ -2128,28 +2667,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug,& - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) else - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) endif ! (CS%mix_boundary_tracers) @@ -2158,26 +2681,21 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! sponges if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) - if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge - call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + ! Layer mode sponge + if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo + !$OMP parallel do default(shared) + do j=js,je + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) else - ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then - do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo - !$OMP parallel do default(shared) - do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) - else - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) - endif + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then - call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("apply_sponge ", tv, G) endif endif ! CS%use_sponge @@ -2238,118 +2756,86 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear is not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass) - if (.not. CS%useALEalgorithm) then - ! Use a tridiagonal solver to determine effect of the diapycnal - ! advection on velocity field. It is assumed that water leaves - ! or enters the ocean with the surface velocity. - if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) - call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do j=js,je + ! Use a tridiagonal solver to determine effect of the diapycnal + ! advection on velocity field. It is assumed that water leaves + ! or enters the ocean with the surface velocity. + if (CS%debug) then + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, US, haloshift=0) + call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) + call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + Idt_accel = 1.0 / dt_in_T + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do j=js,je + do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) + hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect + b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) + d1(I) = hval * b1(I) + u(I,j,1) = b1(I) * (hval * u(I,j,1)) + enddo + do k=2,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) + c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) + eaval = ea(i,j,k) + ea(i+1,j,k) + hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect + b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) + d1(I) = (hval + d1(I)*eaval) * b1(I) + u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) + enddo ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq + u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) + if (associated(ADp%du_dt_dia)) & + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt_accel + enddo ; enddo + if (associated(ADp%du_dt_dia)) then do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) - hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect - b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) - d1(I) = hval * b1(I) - u(I,j,1) = b1(I) * (hval * u(I,j,1)) + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt_accel enddo - do k=2,nz ; do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) - c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) - eaval = ea(i,j,k) + ea(i+1,j,k) - hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect - b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) - d1(I) = (hval + d1(I)*eaval) * b1(I) - u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) - enddo ; enddo - do k=nz-1,1,-1 ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) - if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt - enddo ; enddo - if (associated(ADp%du_dt_dia)) then - do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt - enddo - endif - enddo - if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) endif - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do J=Jsq,Jeq + enddo + if (CS%debug) then + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, US, haloshift=0) + endif + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do J=Jsq,Jeq + do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) + hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect + b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) + d1(I) = hval * b1(I) + v(i,J,1) = b1(i) * (hval * v(i,J,1)) + enddo + do k=2,nz ; do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) + c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) + eaval = ea(i,j,k) + ea(i,j+1,k) + hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect + b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) + d1(i) = (hval + d1(i)*eaval) * b1(i) + v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) + enddo ; enddo + do k=nz-1,1,-1 ; do i=is,ie + v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) + if (associated(ADp%dv_dt_dia)) & + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt_accel + enddo ; enddo + if (associated(ADp%dv_dt_dia)) then do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) - hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect - b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) - d1(I) = hval * b1(I) - v(i,J,1) = b1(i) * (hval * v(i,J,1)) + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt_accel enddo - do k=2,nz ; do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) - c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) - eaval = ea(i,j,k) + ea(i,j+1,k) - hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect - b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) - d1(i) = (hval + d1(i)*eaval) * b1(i) - v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) - enddo ; enddo - do k=nz-1,1,-1 ; do i=is,ie - v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) - if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt - enddo ; enddo - if (associated(ADp%dv_dt_dia)) then - do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt - enddo - endif - enddo - call cpu_clock_end(id_clock_tridiag) - if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) endif - endif ! useALEalgorithm + enddo + call cpu_clock_end(id_clock_tridiag) + if (CS%debug) then + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, US, haloshift=0) + endif call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil - ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -2365,39 +2851,21 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("layered_diabatic()") -end subroutine legacy_diabatic +end subroutine layered_diabatic !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & - evap_CFL_limit, minimum_forcing_depth) + evap_CFL_limit, minimum_forcing_depth, diabatic_aux_CSp) type(diabatic_CS), intent(in ) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure @@ -2406,10 +2874,13 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & !! evaporated in one time-step [nondim]. real, optional, intent( out) :: minimum_forcing_depth !< The smallest depth over which heat !! and freshwater fluxes are applied [m]. + type(diabatic_aux_CS), optional, pointer :: diabatic_aux_CSp !< A pointer to be set to the diabatic_aux + !! control structure ! Pointers to control structures if (present(opacity_CSp)) opacity_CSp => CS%opacity_CSp if (present(optics_CSp)) optics_CSp => CS%optics + if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit @@ -2457,6 +2928,7 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, real :: Idt ! The inverse of the timestep [s-1] real :: ppt2mks = 0.001 ! Conversion factor from g/kg to kg/kg. integer :: i, j, k, is, ie, js, je, nz + logical :: do_saln_tend ! Calculate salinity-based tendency diagnosics is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Idt = 0.0 ; if (dt > 0.0) Idt = 1. / dt @@ -2492,29 +2964,35 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, endif ! salinity tendency - if (CS%id_diabatic_diff_saln_tend > 0) then - do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h) - endif + do_saln_tend = CS%id_diabatic_diff_saln_tend > 0 & + .or. CS%id_diabatic_diff_salt_tend > 0 & + .or. CS%id_diabatic_diff_salt_tend_2d > 0 - ! salt tendency - if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + if (do_saln_tend) then do k=1,nz ; do j=js,je ; do i=is,ie - work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k) + work_3d(i,j,k) = (tv%S(i,j,k) - saln_old(i,j,k)) * Idt enddo ; enddo ; enddo - if (CS%id_diabatic_diff_salt_tend > 0) then - call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) - endif - if (CS%id_diabatic_diff_salt_tend_2d > 0) then - do j=js,je ; do i=is,ie - work_2d(i,j) = 0.0 - do k=1,nz - work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) - enddo - enddo ; enddo - call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) + + if (CS%id_diabatic_diff_saln_tend > 0) & + call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h=h) + + ! salt tendency + if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * ppt2mks * work_3d(i,j,k) + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_salt_tend > 0) then + call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h=h) + endif + if (CS%id_diabatic_diff_salt_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) + endif endif endif @@ -2757,6 +3235,10 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") + call get_param(param_file, mdl, "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic, & + "If true, use a legacy version of the diabatic subroutine. "//& + "This is temporary and is needed to avoid change in answers.", & + default=.true.) call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. "//& "The exact location and properties of those sponges are "//& @@ -2811,33 +3293,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then - ! SET NUMBER OF MODES TO CONSIDER call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes "//& "that will be calculated.", default=1, do_not_log=.true.) - - ! The following parameters are used in testing the internal tide code. - ! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & - "If true, apply an arbitrary generation site for internal tide testing", & - default=.false.) - if (CS%int_tide_source_test)then - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & - "Time interval from start of experiment for adding wave source", & - units="days", default=0) - CS%time_max_source = increment_time(Time,0,days=CS%tlen_days) - endif - ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) - call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, & - "If true, set cg = cg_test everywhere for test case", default=.false.) - if (CS%uniform_cg)then - call get_param(param_file, mdl, "CG_TEST", CS%cg_test, & - "Uniform group velocity of internal tide for test case", default=1.) - endif + call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & + "If positive, a uniform group velocity of internal tide for test case", & + default=-1., units="m s-1", scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & @@ -2874,12 +3335,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "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, scale=US%m_to_Z**2) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m2_s_to_Z2_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%m_to_Z**2) + "over the same distance.", units="m2 s-1", default=0., scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -2921,9 +3382,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%id_wd > 0) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & - 'Zonal Acceleration from Diapycnal Mixing', 'm s-2') + 'Zonal Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & - 'Meridional Acceleration from Diapycnal Mixing', 'm s-2') + 'Meridional Acceleration from Diapycnal Mixing', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model','cn1', diag%axesT1, & @@ -2962,7 +3423,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & - 'Squared buoyancy frequency below mixed layer', 's-2') + 'Squared buoyancy frequency below mixed layer', 's-2', conversion=US%s_to_T**2) CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) endif @@ -2981,9 +3442,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! diagnostics for values prior to diabatic and prior to ALE CS%id_u_predia = register_diag_field('ocean_model', 'u_predia', diag%axesCuL, Time, & - 'Zonal velocity before diabatic forcing', 'm s-1') + 'Zonal velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_predia = register_diag_field('ocean_model', 'v_predia', diag%axesCvL, Time, & - 'Meridional velocity before diabatic forcing', 'm s-1') + 'Meridional velocity before diabatic forcing', 'm s-1', conversion=US%L_T_to_m_s) CS%id_h_predia = register_diag_field('ocean_model', 'h_predia', diag%axesTL, Time, & 'Layer Thickness before diabatic forcing', thickness_units, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & @@ -3001,16 +3462,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_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%Z_to_m**2) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_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%Z_to_m**2, & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z2_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%Z_to_m**2, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') @@ -3272,11 +3733,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity_CSp, CS%optics) endif endif - CS%nsw = 0 - if (associated(CS%optics)) CS%nsw = CS%optics%nbands ! Initialize the diagnostic grid storage call diag_grid_storage_init(CS%diag_grids_prev, G, diag) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 3d9fb3c6c7..e9c5e6a3d0 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -55,17 +55,17 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [s]. + 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 s-1 ~> m2 s-1]. + optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 T-1 ~> m2 s-1]. ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [degC] and g/kg. h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & - Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. + Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing [W m-2]. @@ -94,8 +94,8 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01*US%m_to_Z ! Change this to being an input parameter? - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + 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 @@ -127,8 +127,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [degC]. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [ppt]. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities - !! [Z2 s-1 ~> m2 s-1]. - real, intent(in) :: dt !< The amount of time covered by this call [s]. + !! [Z2 T-1 ~> m2 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 [W m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any @@ -199,7 +199,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. - N2, & ! An estimate of the buoyancy frequency [s-2]. + N2, & ! An estimate of the buoyancy frequency [T-2 ~> s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the @@ -941,7 +941,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) = ((GV%g_Earth*US%m_to_Z**2) * 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*GV%H_to_Z*(h_tr(k-1) + h_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 @@ -952,7 +952,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) = ((GV%g_Earth*US%m_to_Z**2) * 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*GV%H_to_Z*(h_tr(k-1) + h_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 @@ -1334,9 +1334,9 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) CS%id_Sf = register_diag_field('ocean_model', 'EnReqTest_Sf', diag%axesZL, Time, & "Salinity after mixing", "g kg-1") CS%id_N2_0 = register_diag_field('ocean_model', 'EnReqTest_N2_0', diag%axesZi, Time, & - "Squared buoyancy frequency before mixing", "second-2") + "Squared buoyancy frequency before mixing", "second-2", conversion=US%s_to_T**2) CS%id_N2_f = register_diag_field('ocean_model', 'EnReqTest_N2_f', diag%axesZi, Time, & - "Squared buoyancy frequency after mixing", "second-2") + "Squared buoyancy frequency after mixing", "second-2", conversion=US%s_to_T**2) end subroutine diapyc_energy_req_init diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index e4b294d3d8..b486e1e2ca 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -7,10 +7,11 @@ module MOM_energetic_PBL 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 +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_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 @@ -32,41 +33,37 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private - real :: mstar !< The ratio of the friction velocity cubed to the TKE available to - !! drive entrainment, nondimensional. This quantity is the vertically - !! integrated shear production minus the vertically integrated - !! dissipation of TKE produced by shear. + + !/ Constants + real :: VonKar = 0.41 !< The von Karman coefficient. This should be runtime, but because + !! it is runtime in KPP and set to 0.4 it might change answers. + real :: omega !< The Earth's rotation rate [T-1]. + real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of + !! the absolute rotation rate blended with the local value of f, as + !! sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. + + !/ Convection related terms real :: nstar !< The fraction of the TKE input to the mixed layer available to drive !! entrainment [nondim]. This quantity is the vertically integrated !! buoyancy production minus the vertically integrated dissipation of !! TKE produced by buoyancy. + + !/ Mixing Length terms + logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. + logical :: MLD_iteration_guess=.false. !< False to default to guessing half the + !! ocean depth for the iteration. + integer :: max_MLD_its !< The maximum number of iterations that can be used to find a + !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. - real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by !! mechanically forced entrainment of the mixed layer is converted to !! TKE [nondim]. -! real :: Hmix_min !< The minimum mixed layer thickness in m. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [m 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. - real :: omega !< The Earth's rotation rate [s-1]. - real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of - !! the absolute rotation rate blended with the local value of f, as - !! sqrt((1-of)*f^2 + of*4*omega^2). - real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released - !! energy is converted to a turbulent velocity, relative to - !! mechanically forced turbulent kinetic energy [nondim]. - !! Making this larger increases the diffusivity. - integer :: vstar_mode !< An integer marking the chosen method for finding vstar. - !! vstar = 0 is the original (TKE_remaining)^1/3 - !! vstar = 1 is the version described by Reichl and Hallberg, 2018 - real :: vstar_surf_fac !< If (vstar == 1) this is the proportionality coefficient between - !! ustar and the surface mechanical contribution to vstar - real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit - !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the - !! diffusive length scale by rotation. Making this larger decreases + !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. real :: transLay_scale !< A scale for the mixing length in the transition layer !! at the edge of the boundary layer as a fraction of the @@ -76,60 +73,69 @@ module MOM_energetic_PBL !! 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. - real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE - !! due to enhanced dissipation in the presence of negative (unstable) - !! local stratification. This dissipation is applied to the available - !! TKE which includes both that generated at the surface and that - !! generated at depth. - real :: N2_Dissipation_Scale_Pos !< A nondimensional scaling factor controlling the loss of TKE - !! due to enhanced dissipation in the presence of positive (stable) - !! local stratification. This dissipation is applied to the available - !! TKE which includes both that generated at the surface and that - !! generated at depth. - !MSTAR related options - real :: MSTAR_CAP !< Since MSTAR is restoring undissipated energy to mixing, + + !/ Velocity scale terms + integer :: wT_scheme !< An enumerated value indicating the method for finding the turbulent + !! velocity scale. There are currently two options: + !! wT_mwT_from_cRoot_TKE is the original (TKE_remaining)^1/3 + !! wT_from_RH18 is the version described by Reichl and Hallberg, 2018 + real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released + !! energy is converted to a turbulent velocity, relative to + !! mechanically forced turbulent kinetic energy [nondim]. + !! Making this larger increases the diffusivity. + real :: vstar_surf_fac !< If (wT_scheme == wT_from_RH18) this is the proportionality coefficient between + !! ustar and the surface mechanical contribution to vstar [nondim] + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit + !! conversion factor [Z s T-1 m-1 ~> nondim]. Making this larger increases + !! the diffusivity. + + !mstar related options + integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar + logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. + real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing, !! there must be a cap on how large it can be. This !! is definitely a function of latitude (Ekman limit), !! but will be taken as constant for now. - real :: MSTAR_SLOPE !< Slope of the function which relates the shear production to the - !< mixing layer depth, Ekman depth, and Monin-Obukhov depth. - real :: MSTAR_XINT !< Value where MSTAR function transitions from linear - !! to decay toward MSTAR->0 at fully developed Ekman depth. - real :: MSTAR_XINT_UP !< Similar but for transition to asymptotic cap. - real :: MSTAR_AT_XINT !< Intercept value of MSTAR at value where function - !! changes to linear transition. - real :: RH18_mst_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). + + !/ vertical decay related options + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. + + !/ 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 + !! 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. + + !/ mstar_scheme == 2 + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 + + !/ mstar_scheme == 3 + real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). !! Value of 0.275 in RH18. Increasing this !! coefficient increases mechanical mixing for all values of Hf/ust, !! but is most effective at low values (weakly developed OSBLs). - real :: RH18_mst_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). + real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR !! for all values of HF/ust, with a consistent affect across !! a wide range of Hf/ust. - real :: RH18_mst_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of + real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of !! -5.0 in RH18. Increasing this increases how quickly the value !! of MSTAR decreases as Hf/ust increases. - real :: RH18_mst_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. + real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. !! Value of 0.2 in RH18. - real :: RH18_mst_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. + real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. !! Value of 0.4 in RH18. - real :: MSTAR_N = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB - real :: MSTAR_A !< Coefficients of expressions for mstar in asymptotic limits, computed - !! to match the function value and slope at both ends of the linear fit - !! within the well constrained region. - real :: MSTAR_A2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: MSTAR_B !< Coefficients of expressions for mstar in asymptotic limits. - real :: MSTAR_B2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 - real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 - !Langmuir turbulence related parameters + + !/ Coefficient for shear/convective turbulence interaction + real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable. + + !/ Langmuir turbulence related parameters + logical :: Use_LT = .false. !< Flag for using LT in Energy calculation integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement - logical :: LT_ENH_K_R16 !< Logical to toggle enhanced local mixing coefficient due to Langmuir - !! following Reichl et al., 2016. This setting is unverified - !! outside of strongly shear-forced shear turbulence and therefore - !! it is not recommended to employ this option for general use. real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of !! the mixed layer depth over the Ekman depth. real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of @@ -141,69 +147,90 @@ module MOM_energetic_PBL real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of !! the Ekman depth over the Obukov depth with destablizing forcing. real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing. - real :: CNV_MST_FAC !< Factor to reduce mstar when statically unstable. + + !/ Others type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. - integer :: MSTAR_MODE = 0 !< An coded integer to determine which formula is used to set mstar - integer :: CONST_MSTAR=0 !< The value of MSTAR_MODE to use a constant mstar - integer :: MLD_o_OBUKHOV=1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed - !! layer depth to the Obukhov depth - integer :: EKMAN_o_OBUKHOV=2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman - !! layer depth to the Obukhov depth - integer :: MSTAR_RH18 = 3 !< The value of MSTAR_MODE to base mstar off of RH18 - logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. - logical :: Use_LT = .false. !< Flag for using LT in Energy calculation - logical :: orig_PE_calc = .true. !< If true, the ePBL code uses the original form of the + 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 :: orig_PE_calc !< If true, the ePBL code uses the original form of the !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. - logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. - logical :: Orig_MLD_iteration=.false. !< False to use old MLD value - logical :: MLD_iteration_guess=.false. !< False to default to guessing half the - !! ocean depth for the iteration. - logical :: Mixing_Diagnostics = .false. !< Will be true when outputting mixing - !! length and velocity scales - logical :: MSTAR_Diagnostics=.false. !< If true, utput diagnostics of the mstar calculation. type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - ! These are terms in the mixed layer TKE budget, all in [J m-2] = [kg s-2]. real, allocatable, dimension(:,:) :: & - diag_TKE_wind, & !< The wind source of TKE [J m-2]. - diag_TKE_MKE, & !< The resolved KE source of TKE [J m-2]. - diag_TKE_conv, & !< The convective source of TKE [J m-2]. - diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating [J m-2]. - diag_TKE_mech_decay, & !< The decay of mechanical TKE [J m-2]. - diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. - diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer [J m-2]. - ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) - ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) - Enhance_M, & !< The enhancement to the turbulent velocity scale [nondim] + ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m]. + + ! These are terms in the mixed layer TKE budget, all in [kg m-3 Z3 T-2 ~> J m-2] = [kg s-2]. + real, allocatable, dimension(:,:) :: & + diag_TKE_wind, & !< The wind source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_MKE, & !< The resolved KE source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_conv, & !< The convective source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating + !! [kg m-3 Z3 T-2 ~> W m-2]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_conv_decay, & !< The decay of convective TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [kg m-3 Z3 T-3 ~> W m-2]. + ! These additional diagnostics are also 2d. MSTAR_MIX, & !< Mstar used in EPBL [nondim] - MSTAR_LT, & !< Mstar for Langmuir turbulence [nondim] - MLD_EKMAN, & !< MLD over Ekman length [nondim] - MLD_OBUKHOV, & !< MLD over Obukhov length [nondim] - EKMAN_OBUKHOV, & !< Ekman over Obukhov length [nondim] + MSTAR_LT, & !< Mstar due to Langmuir turbulence [nondim] LA, & !< Langmuir number [nondim] LA_MOD !< Modified Langmuir number [nondim] real, allocatable, dimension(:,:,:) :: & - Velocity_Scale, & !< The velocity scale used in getting Kd [Z s-1 ~> m s-1] + Velocity_Scale, & !< The velocity scale used in getting Kd [Z T-1 ~> m s-1] Mixing_Length !< The length scale used in getting Kd [Z ~> m] !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1 integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 - integer :: id_Hsfc_used = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 - integer :: id_OSBL = -1, id_LT_Enhancement = -1, id_MSTAR_mix = -1 - integer :: id_mld_ekman = -1, id_mld_obukhov = -1, id_ekman_obukhov = -1 - integer :: id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 + integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 !!@} end type energetic_PBL_CS +!>@{ Enumeration values for mstar_Scheme +integer, parameter :: Use_Fixed_MStar = 0 !< The value of mstar_scheme to use a constant mstar +integer, parameter :: MStar_from_Ekman = 2 !< The value of mstar_scheme to base mstar on the ratio + !! of the Ekman layer depth to the Obukhov depth +integer, parameter :: MStar_from_RH18 = 3 !< The value of mstar_scheme to base mstar of of RH18 +integer, parameter :: No_Langmuir = 0 !< The value of LT_ENHANCE_FORM not use Langmuir turbolence. +integer, parameter :: Langmuir_rescale = 2 !< The value of LT_ENHANCE_FORM to use a multiplicative + !! rescaling of mstar to account for Langmuir turbulence. +integer, parameter :: Langmuir_add = 3 !< The value of LT_ENHANCE_FORM to add a contribution to + !! mstar from Langmuir turblence to other contributions. +integer, parameter :: wT_from_cRoot_TKE = 0 !< Use a constant times the cube root of remaining TKE + !! to calculate the turbulent velocity. +integer, parameter :: wT_from_RH18 = 1 !< Use a scheme based on a combination of w* and v* as + !! documented in Reichl & Hallberg (2018) to calculate + !! the turbulent velocity. +character*(20), parameter :: CONSTANT_STRING = "CONSTANT" +character*(20), parameter :: OM4_STRING = "OM4" +character*(20), parameter :: RH18_STRING = "REICHL_H18" +character*(20), parameter :: ROOT_TKE_STRING = "CUBE_ROOT_TKE" +character*(20), parameter :: NONE_STRING = "NONE" +character*(20), parameter :: RESCALED_STRING = "RESCALE" +character*(20), parameter :: ADDITIVE_STRING = "ADDITIVE" +!!@} + +!> A type for conveniently passing around ePBL diagnostics for a column. +type, public :: ePBL_column_diags ; private + !>@{ Local column copies of energy change diagnostics, all in [kg m-3 Z3 T-3 ~> W m-2]. + real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing + real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay + !!@} + real :: LA !< The value of the Langmuir number [nondim] + real :: LAmod !< The modified Langmuir number by convection [nondim] + real :: mstar !< The value of mstar used in ePBL [nondim] + real :: mstar_LT !< The portion of mstar due to Langmuir turbulence [nondim] + real, allocatable, dimension(:) :: dT_expect !< Expected temperature changes [degC] + real, allocatable, dimension(:) :: dS_expect !< Expected salinity changes [ppt] +end type ePBL_column_diags + contains !> This subroutine determines the diffusivities from the integrated energetics @@ -211,8 +238,8 @@ module MOM_energetic_PBL !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, Buoy_Flux, dt_diag, last_call, & - dT_expected, dS_expected, waves ) + dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & + dT_expected, dS_expected, Waves ) 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 @@ -220,10 +247,10 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS intent(inout) :: h_3d !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: u_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: v_3d !< Zonal velocities interpolated to h points - !! [m s-1]. + !! [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: dSV_dT !< The partial derivative of in-situ specific !! volume with potential temperature @@ -234,24 +261,23 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the !! forcing that has been applied to each layer - !! through each layer [J m-2]. + !! [kg m-3 Z3 T-2 ~> J m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + 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 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3]. + intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two callse to - !! mixedlayer [s]. + !! than dt if there are two calls to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< If true, this is the last call to !! mixedlayer in the current time step, so !! diagnostics will be written. The default @@ -281,63 +307,336 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing. ! ! The key parameters for the mixed layer are found in the control structure. -! These include mstar, nstar, TKE_decay, and conv_decay. For the Oberhuber (1993) mixed layer, -! the values of these are: +! To use the classic constant mstar mixied layers choose MSTAR_SCHEME=CONSTANT. +! The key parameters then include mstar, nstar, TKE_decay, and conv_decay. +! For the Oberhuber (1993) mixed layer,the values of these are: ! mstar = 1.25, nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 -! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while -! conv_decay is 1/mu. -! For a traditional Kraus-Turner mixed layer, the values are: +! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. +! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - h, & ! The layer thickness [H ~> m or kg m-2]. - T, & ! The layer temperatures [degC]. - S, & ! The layer salinities [ppt]. - u, & ! The zonal velocity [m s-1]. - v ! The meridional velocity [m s-1]. + h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. + T_2d, & ! A 2-d slice of the layer temperatures [degC]. + S_2d, & ! A 2-d slice of the layer salinities [ppt]. + TKE_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. + dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. + dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. + 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, & ! The diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - pres, & ! Interface pressures [Pa]. + Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real, dimension(SZK_(GV)) :: & + h, & ! The layer thickness [H ~> m or kg m-2]. + T0, & ! The initial layer temperatures [degC]. + S0, & ! The initial layer salinities [ppt]. + dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. + dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. + TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. + 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]. + mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1]. + mixlen ! A turbulent mixing length [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 :: absf ! The absolute value of f [T-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 :: 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]. + +! The following are only used for diagnostics. + real :: dt__diag ! A 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. + + logical :: debug=.false. ! Change this hard-coded value for debugging. + type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics. + + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& + "Module must be initialized before it is used.") + + 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 mixedlayer!") + debug = .false. ; if (present(dT_expected) .or. present(dS_expected)) debug = .true. + + if (debug) allocate(eCD%dT_expect(nz), eCD%dS_expect(nz)) + + h_neglect = GV%H_subroundoff + + dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag + write_diags = .true. ; if (present(last_call)) write_diags = last_call + + + ! Determine whether to zero out diagnostics before accumulation. + reset_diags = .true. + if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & + reset_diags = .false. ! This is the second call to mixedlayer. + + if (reset_diags) then + if (CS%TKE_diagnostics) then +!!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 + CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 + CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 + enddo ; enddo + endif + endif + ! 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,debug, & +!!OMP 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 + h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = u_3d(i,j,k) ; v_2d(i,k) = v_3d(i,j,k) + T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) + 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 + + ! 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 + ! surface cooling & brine rejection down through the topmost cell, and + ! homogenizing the shortwave heating within that cell. This sets the energy + ! and ustar and wstar available to drive mixing at the first interior + ! interface. + do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + + ! 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) + 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) + 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) & + u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + & + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + endif + if (u_star < CS%ustar_min) u_star = CS%ustar_min + if (CS%omega_frac >= 1.0) then + absf = 2.0*CS%omega + else + 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 + + ! 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) + + 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, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + + + ! Copy the diffusivities to a 2-d array. + do K=1,nz+1 + Kd_2d(i,K) = Kd(K) + enddo + CS%ML_depth(i,j) = MLD_io + + if (present(dT_expected)) then + do k=1,nz ; dT_expected(i,j,k) = eCD%dT_expect(k) ; enddo + endif + if (present(dS_expected)) then + do k=1,nz ; dS_expected(i,j,k) = eCD%dS_expect(k) ; enddo + endif + + if (CS%TKE_diagnostics) then + CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + eCD%dTKE_MKE + CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + eCD%dTKE_conv + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + eCD%dTKE_forcing + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + eCD%dTKE_wind + CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + eCD%dTKE_mixing + CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + eCD%dTKE_mech_decay + CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + eCD%dTKE_conv_decay + ! CS%diag_TKE_unbalanced(i,j) = CS%diag_TKE_unbalanced(i,j) + eCD%dTKE_unbalanced + endif + ! Write to 3-D for outputing Mixing length and velocity scale. + if (CS%id_Mixing_Length>0) then ; do k=1,nz + CS%Mixing_Length(i,j,k) = mixlen(k) + enddo ; endif + if (CS%id_Velocity_Scale>0) then ; do k=1,nz + CS%Velocity_Scale(i,j,k) = mixvel(k) + enddo ; endif + if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = eCD%mstar + if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = eCD%mstar_LT + if (allocated(CS%La)) CS%La(i,j) = eCD%LA + if (allocated(CS%La_mod)) CS%La_mod(i,j) = eCD%LAmod + else ! End of the ocean-point part of the i-loop + ! For masked points, Kd_int must still be set (to 0) because it has intent out. + do K=1,nz+1 ; Kd_2d(i,K) = 0. ; enddo + CS%ML_depth(i,j) = 0.0 + + if (present(dT_expected)) then + do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo + endif + if (present(dS_expected)) then + do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo + endif + endif ; enddo ! Close of i-loop - Note unusual loop order! + + do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo + + enddo ! j-loop + + if (write_diags) then + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + endif + + if (debug) deallocate(eCD%dT_expect, eCD%dS_expect) + +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, & + dt_diag, Waves, G, i, j) + 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) :: u !< Zonal velocities interpolated to h points + !! [m s-1]. + real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points + !! [m s-1]. + real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [degC]. + real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [ppt]. + + real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific + !! volume with potential temperature + !! [m3 kg-1 degC-1]. + real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific + !! volume with salinity [m3 kg-1 ppt-1]. + real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the + !! forcing that has been applied to each layer + !! [kg m-3 Z3 T-2 ~> J m-2]. + real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1]. + 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(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and + !! 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]. + real, dimension(SZK_(GV)+1), & + intent(out) :: mixvel !< The mixing velocity scale used in Kd + !! [Z T-1 ~> m s-1]. + real, dimension(SZK_(GV)+1), & + intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. + type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous + !! call to mixedlayer_init. + type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [T ~> s]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS for Langmuir turbulence + type(ocean_grid_type), & + optional, intent(inout) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) + integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + +! This subroutine determines the diffusivities in a single column from the integrated energetics +! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes +! have already been applied. All calculations are done implicitly, and there +! is no stability limit on the time step. +! +! For each interior interface, first discard the TKE to account for mixing +! of shortwave radiation through the next denser cell. Next drive mixing based +! on the local? values of ustar + wstar, subject to available energy. This +! step sets the value of Kd(K). Any remaining energy is then subject to decay +! before being handed off to the next interface. mech_TKE and conv_PErel are treated +! separately for the purposes of decay, but are used proportionately to drive +! mixing. + + ! Local variables + real, dimension(SZK_(GV)+1) :: & pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. + ! movements into changes in column potential energy [kg m-3 Z2 T-2 ~> kg m-1 s-2]. hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. - real, dimension(SZI_(G)) :: & - mech_TKE, & ! The mechanically generated turbulent kinetic energy - ! available for mixing over a time step [J m-2 = kg s-2]. - conv_PErel, & ! The potential energy that has been convectively released - ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC + real :: mech_TKE ! The mechanically generated turbulent kinetic energy + ! available for mixing over a time step [kg m-3 Z3 T-2 ~> J m-2]. + real :: conv_PErel ! The potential energy that has been convectively released + ! during this timestep [kg m-3 Z3 T-2 ~> J m-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. - htot, & ! The total depth of the layers above an interface [H ~> m or kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - mech_TKE_top, & ! The value of mech_TKE at the top of the column [J m-2]. - conv_PErel_top, & ! The value of conv_PErel at the top of the column [J m-2]. - - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. - h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. - absf ! The absolute value of f [s-1]. + real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. + real :: uhtot ! The depth integrated zonal and meridional velocities in the + real :: vhtot ! 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, dimension(SZI_(G),SZK_(GV)) :: & - dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. - dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column, in - ! units of [J m-2 degC-1] and [J m-2 ppt-1]. real, dimension(SZK_(GV)) :: & - T0, S0, & ! Initial values of T and S in the column, in [degC] and [ppt]. - Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. + dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes + ! within a layer [Z degC-1 ~> m degC-1]. + dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes + ! within a layer [Z ppt-1 ~> m ppt-1]. + dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature + ! changes within a layer, in [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes + ! within a layer, in [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z degC-1 ~> m degC-1]. + dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z ppt-1 ~> m ppt-1]. + dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. c1, & ! c1 is used by the tridiagonal solver [nondim]. - dTe, dSe ! Running (1-way) estimates of temperature and salinity change. - real, dimension(SZK_(GV)) :: & + Te, & ! Estimated final values of T in the column [degC]. + Se, & ! Estimated final values of S in the column [ppt]. + dTe, & ! Running (1-way) estimates of temperature change [degC]. + dSe, & ! Running (1-way) estimates of salinity change [ppt]. Th_a, & ! An effective temperature times a thickness in the layer above, including implicit ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit @@ -346,10 +645,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. Sh_b ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(SZI_(G)) :: & - hp_a ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above [H ~> m or kg m-2]. This is the first term - ! in the denominator of b1 in a downward-oriented tridiagonal solver. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of @@ -357,20 +652,23 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS 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]. + real :: hp_a ! An effective pivot thickness of the layer including the effects + ! of coupling with layers above [H ~> m or kg m-2]. This is the first term + ! 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 :: dMass ! The mass per unit area within a layer [kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [Pa]. + real :: dMass ! The mass per unit area within a layer [Z kg m-3 ~> kg m-2]. + real :: dPres ! The hydrostatic pressure change across a layer [kg m-3 Z2 T-2 ~> kg m-1 s-2 = Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface [J m-2 = kg s-2]. + ! the water above the interface [kg m-3 Z3 T-2 ~> J m-2]. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! 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 s m-2 ~> s m-1 or kg s m-4]. + ! a layer, times a thickness conversion factor [H T m-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 [Z ~> m]. real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. @@ -381,22 +679,21 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. real :: C1_3 ! = 1/3. - real :: vonKar ! The vonKarman constant. - real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is - ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. - real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. - real :: vstar ! An in-situ turbulent velocity [m s-1]. - real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. - real :: LA ! The Langmuir number [nondim] - real :: LAmod ! A modified Langmuir number accounting for other parameters. + real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m6 Z-3 kg-1 T2 s-3 ~> m3 kg-1 s-1]. + ! This is used convert TKE back into ustar^3. + 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 [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 ~> 1 or m3 kg-1]. 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. - real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. - real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. + real :: tot_TKE ! The total TKE available to support mixing at interface K [kg m-3 Z3 T-2 ~> J m-2]. + real :: TKE_here ! The total TKE at this point in the algorithm [kg m-3 Z3 T-2 ~> J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature ! change in the layer above the interface [degC]. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity @@ -407,24 +704,24 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. - real :: dPE_conv ! The convective change in column potential energy [J m-2]. - real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. - real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [J m-2] + real :: dPE_conv ! The convective change in column potential energy [kg m-3 Z3 T-2 ~> J m-2]. + real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. + real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [kg m-3 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 :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [kg m-3 Z3 T-2 ~> J m-2] real :: dPEa_dKd_g0 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]. - real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). + real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) - ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. + ! for very small values of Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real :: PE_chg ! The change in potential energy due to mixing at an - ! interface [J m-2], positive for the column increasing + ! interface [kg m-3 Z3 T-2 ~> J m-2], positive for the column increasing ! in potential energy (i.e., consuming TKE). real :: TKE_left ! The amount of turbulent kinetic energy left for the most - ! recent guess at Kddt_h(K) [J m-2]. + ! recent guess at Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [J m-2]. + real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [kg m-3 Z3 T-2 ~> J m-2]. real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. @@ -432,1187 +729,712 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. + real :: vstar_unit_scale ! A unit converion factor for turbulent velocities [Z T-1 s m-1 ~> 1] logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). - logical :: convectively_stable - logical, dimension(SZI_(G)) :: & - sfc_connected ! If true the ocean is actively turbulent from the present + logical :: convectively_stable ! If true the water column is convectively stable at this interface. + logical :: sfc_connected ! If true the ocean is actively turbulent from the present ! interface all the way up to the surface. logical :: sfc_disconnect ! If true, any turbulence has become disconnected ! from the surface. -! The following is only used as a diagnostic. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. - real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. - real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region [Z ~> m]. - logical :: write_diags ! If true, write out diagnostics with this step. - logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! Local column copies of energy change diagnostics, all [J m-2]. - real :: dTKE_conv, dTKE_forcing, dTKE_mixing - real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay +! The following are only used for diagnostics. + real :: dt__diag ! A copy of dt_diag (if present) or dt [T]. + real :: I_dtdiag ! = 1.0 / dt__diag [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 [Z ~> m]. - real :: max_MLD, min_MLD ! Iteration bounds [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. - ! 3. Based on result adjusts the Max/Min - ! and searches through the water column. - ! - If using an accurate guess the iteration - ! is very quick (e.g. if MLD doesn't change - ! over timestep). Otherwise it takes 5-10 - ! passes, but has a high convergence rate. - ! Other iteration may be tried, but this - ! method seems to rarely fail and the added - ! cost is likely not significant. Additionally, - ! when it fails it does so in a reasonable - ! manner giving a usable guess. When it - ! does fail, it is due to convection within - ! the boundary. Likely, a new method e.g. - ! surface_disconnect, can improve this. + real :: min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step + real :: max_MLD ! - 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. + ! 3. Based on result adjusts the Max/Min and searches through the water column. + ! - If using an accurate guess the iteration is very quick (e.g. if MLD doesn't + ! change over timestep). Otherwise it takes 5-10 passes, but has a high + ! convergence rate. Other iteration may be tried, but this method seems to + ! fail very rarely and the added cost is likely not significant. + ! Additionally, when it fails to converge it does so in a reasonable + ! 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. logical :: FIRST_OBL ! Flag for computing "found" Mixing layer depth - logical :: OBL_CONVERGED ! Flag for convergence of MLD - integer :: OBL_IT ! Iteration counter -!### These need to be made into run-time parameters. - integer :: MAX_OBL_IT=20 ! Set maximum number of iterations. Probably - ! best as an input parameter, but then may want - ! to use allocatable arrays if storing - ! guess/found (as diagnostic); skipping for now. - ! In reality, the maximum number of guesses - ! needed is set by: - ! DEPTH/2^M < DZ - ! where M is the number of guesses - ! e.g. M=12 for DEPTH=4000m and DZ=1m - real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store - Mixing_Length_Used ! Vstar and Mixing_Length - !/BGR - remaining variables are related to tracking iteration statistics. - logical :: OBL_IT_STATS=.false. ! Flag for computing OBL iteration statistics - REAL :: ITguess(20), ITresult(20),ITmax(20),ITmin(20) ! Flag for storing guess/result - ! should have dim=MAX_OBL_IT - integer, save :: MAXIT=0 ! Stores maximum number of iterations - integer, save :: MINIT=1e8 ! Stores minimum number of iterations - integer, save :: SUMIT=0 ! Stores total iterations (summed over all) - integer, save :: NUMIT=0 ! Stores number of times iterated - !e.g. Average iterations = SUMIT/NUMIT - integer, save :: CONVERGED! - integer, save :: NOTCONVERGED! - !-End BGR iteration parameters----------------------------------------- - real :: N2_dissipation - real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) - real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales [Z ~> m]. - real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. - real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. - real :: MLD_o_Ekman ! > - real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_stab ! > - real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_un ! > - - real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov - real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length - real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale - real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar - ! cubed) which is computed as a function of latitude, boundary layer depth, - ! and the Monin-Obukhov depth. - real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence - real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. - real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. + logical :: OBL_converged ! Flag for convergence of MLD + integer :: OBL_it ! Iteration counter + real :: Surface_Scale ! Surface decay scale for vstar - real :: K_Enhancement ! A local enhancement of K, perhaps due to Langmuir turbulence - ! For LT_ENH_K_R16 - real :: Shape_Function ! The shape function of the enhancement - real, parameter :: Max_Shape_Function = 0.148148 ! The max value of the shape function of the enhancement - real, parameter :: Max_K_Enhancement = 2.25 ! The max value of the enhancement - !-End for LT_ENH_K_R16 + logical :: debug=.false. ! Change this hard-coded value for debugging. ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt - real, dimension(SZI_(G),SZK_(GV)) :: & - mech_TKE_k, conv_PErel_k - real, dimension(SZK_(GV)) :: nstar_k + real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k integer, dimension(SZK_(GV)) :: num_itts - integer :: i, j, k, is, ie, js, je, nz, itt, max_itt + integer :: k, nz, itt, max_itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") - 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 mixedlayer!") - if (present(dT_expected) .or. present(dS_expected)) debug = .true. + debug = .false. ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) debug = .true. h_neglect = GV%H_subroundoff - if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 C1_3 = 1.0 / 3.0 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - IdtdR0 = 1.0 / (dt__diag * GV%Rho0) - write_diags = .true. ; if (present(last_call)) write_diags = last_call + I_dtdiag = 1.0 / dt__diag max_itt = 20 h_tt_min = 0.0 - vonKar = 0.41 - mstar_mix=CS%MSTAR!Initialize to mstar - I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) + 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) + vstar_unit_scale = US%m_to_Z * US%T_to_s + + 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 +! surface cooling & brine rejection down through the topmost cell, and +! homogenizing the shortwave heating within that cell. This sets the energy +! and ustar and wstar available to drive mixing at the first interior +! interface. + + do K=1,nz+1 ; Kd(K) = 0.0 ; enddo + + pres_Z(1) = 0.0 + do k=1,nz + dMass = US%m_to_Z * GV%H_to_kg_m2 * h(k) + dPres = US%L_to_Z**2 * GV%g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling + dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dT(k) + dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dS(k) + dT_to_dColHt(k) = dMass * dSV_dT(k) + dS_to_dColHt(k) = dMass * dSV_dS(k) + + pres_Z(K+1) = pres_Z(K) + dPres + enddo - ! Determine whether to zero out diagnostics before accumulation. - reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & - reset_diags = .false. ! This is the second call to mixedlayer. + ! 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 + hb_hs(nz+1) = 0.0 + do k=nz,1,-1 + h_bot = h_bot + h(k) + hb_hs(K) = h_bot * I_hs + enddo - if (reset_diags) then - if (CS%TKE_diagnostics) then -!!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 - CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 - CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced_forcing(i,j) = 0.0 - enddo ; enddo - endif -!!OMP parallel do default(none) shared(CS) - if (CS%Mixing_Diagnostics) then - CS%Mixing_Length(:,:,:) = 0.0 - CS%Velocity_Scale(:,:,:) = 0.0 - endif - endif + MLD_output = h(1)*GV%H_to_Z + !/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)*GV%H_to_Z ; enddo + !min_MLD will initialize as 0. + min_MLD = 0.0 -!!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,IdtdR0, & -!!OMP TKE_forced,debug,H_neglect,dSV_dT, & -!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & -!!OMP max_itt,Kd_int) & -!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & -!!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & -!!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & -!!OMP pres,pres_Z,dMass,dPres,dT_to_dPE,dS_to_dPE, & -!!OMP dT_to_dColHt,dS_to_dColHt,Kddt_h,hp_a, & -!!OMP Th_a,Sh_a,Th_b,Sh_b,dT_to_dPE_a,htot, & -!!OMP dT_to_dColHt_a,dS_to_dColHt_a,uhtot,vhtot, & -!!OMP Idecay_len_TKE,exp_kh,nstar_FC,tot_TKE, & -!!OMP TKE_reduc,dTe_t2,dSe_t2,dTe,dSe,dt_h, & -!!OMP Convectively_stable,sfc_disconnect,b1, & -!!OMP c1,dT_km1_t2,dS_km1_t2,dTe_term, & -!!OMP dSe_term,MKE2_Hharm,vstar,h_tt,h_rsum, & -!!OMP Kd_guess0,Kddt_h_g0,dPEc_dKd_Kd0, & -!!OMP PE_chg_max,dPEa_dKd_g0,PE_chg_g0, & -!!OMP MKE_src,dPE_conv,Kddt_h_max,Kddt_h_min, & -!!OMP dTKE_conv, dTKE_forcing, dTKE_mixing, & -!!OMP dTKE_MKE,dTKE_mech_decay,dTKE_conv_decay,& -!!OMP TKE_left_max,TKE_left_min,Kddt_h_guess, & -!!OMP TKE_left_itt,dPEa_dKd_itt,PE_chg_itt, & -!!OMP MKE_src_itt,Kddt_h_itt,dPEc_dKd,PE_chg, & -!!OMP dMKE_src_dK,TKE_left,use_Newt, & -!!OMP dKddt_h_Newt,Kddt_h_Newt,Kddt_h_next, & -!!OMP dKddt_h,Te,Se,Hsfc_used,dS_to_dPE_a, & -!!OMP dMKE_max,sfc_connected,TKE_here) - do j=js,je - ! Copy the thicknesses and other fields to 2-d arrays. - do k=1,nz ; do i=is,ie - h(i,k) = h_3d(i,j,k) + h_neglect ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) - T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) - Kd(i,K) = 0.0 - enddo ; enddo - do i=is,ie - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z - sfc_connected(i) = .true. - enddo - - if (debug) then - mech_TKE_k(:,:) = 0.0 ; conv_PErel_k(:,:) = 0.0 - endif + ! 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) - ! 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 - ! surface cooling & brine rejection down through the topmost cell, and - ! homogenizing the shortwave heating within that cell. This sets the energy - ! and ustar and wstar available to drive mixing at the first interior - ! interface. - do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + ! Iterate to determine a converged EPBL depth. + OBL_converged = .false. + do OBL_it=1,CS%Max_MLD_Its - U_star = fluxes%ustar(i,j) - U_Star_Mean = fluxes%ustar_gustless(i,j) - 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 + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) - endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (.not. OBL_converged) then + ! If not using MLD_Iteration flag loop to only execute once. + if (.not.CS%Use_MLD_iteration) OBL_converged = .true. + + if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif - ! Computing Bf w/ limiters. - Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable - if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega + ! Reset ML_depth + MLD_output = h(1)*GV%H_to_Z + sfc_connected = .true. + + !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 + if (CS%Use_LT) then + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=h, U_H=u, V_H=v, Waves=Waves) + call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & + MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& + mstar_LT=mstar_LT) else - absf(i) = 0.25*US%s_to_T*((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(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) + call find_mstar(CS, US, B_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) endif - ! Computing stability scale which correlates with TKE for mixing, where - ! TKE for mixing = TKE production minus TKE dissipation - Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) - ! Inverse of Ekman and Obukhov - iL_Ekman = absf(i) / U_star - iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) - if (CS%USE_LT) then - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - !### Consider recoding this as... - ! Max_ratio = 1.0e16 - ! Ekman_Obukhov = Max_ratio - ! if (abs(buoy_flux(i,j)*vonkar) < Max_ratio*(absf(i) * U_star**2)) & - ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) - ! if (buoy_flux(i,j) > 0.0) then - ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 - ! else - ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 - ! endif + + !/ Apply MStar to get mech_TKE + if ((CS%answers_2018) .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) endif - if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * US%Z_to_m**3 * U_star**3 - conv_PErel(i) = 0.0 - - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif + if (CS%TKE_diagnostics) then + eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 + eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0 - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 + eCD%dTKE_wind = mech_TKE * I_dtdiag + if (TKE_forcing(1) <= 0.0) then + eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * I_dtdiag + ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * I_dtdiag else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) + eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * I_dtdiag + ! eCD%dTKE_unbalanced = 0.0 endif + endif + if (TKE_forcing(1) <= 0.0) then + mech_TKE = mech_TKE + TKE_forcing(1) + if (mech_TKE < 0.0) mech_TKE = 0.0 + conv_PErel = 0.0 + else + conv_PErel = TKE_forcing(1) endif -! endif ; enddo -! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + ! Store in 1D arrays for output. + do K=1,nz+1 ; mixvel(K) = 0.0 ; mixlen(K) = 0.0 ; enddo - h_sum(i) = H_neglect ; do k=1,nz ; h_sum(i) = h_sum(i) + h(i,k) ; enddo - I_hs = 0.0 ; if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) + ! Determine the mixing shape function MixLen_shape. + if ((.not.CS%Use_MLD_iteration) .or. & + (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then + do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo + elseif (MLD_guess <= 0.0) then + if (CS%transLay_scale > 0.0) then ; do K=1,nz+1 + MixLen_shape(K) = CS%transLay_scale + enddo ; else ; do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo ; endif + else + ! Reduce the mixing length based on MLD, with a quadratic + ! expression that follows KPP. + I_MLD = 1.0 / MLD_guess + h_rsum = 0.0 + MixLen_shape(1) = 1.0 + do K=2,nz+1 + h_rsum = h_rsum + h(k-1)*GV%H_to_Z + 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 + else + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent + endif + enddo + endif - h_bot = 0.0 ; hb_hs(i,nz+1) = 0.0 - do k=nz,1,-1 - h_bot = h_bot + h(i,k) - hb_hs(i,K) = h_bot * I_hs - enddo + Kd(1) = 0.0 ; Kddt_h(1) = 0.0 + hp_a = h(1) + 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) - pres(i,1) = 0.0 ; pres_Z(i,1) = 0.0 - do k=1,nz - dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) - dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) - dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) - - pres(i,K+1) = pres(i,K) + dPres - pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) - enddo + htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1) -! endif ; enddo - - ! Note the outer i-loop and inner k-loop loop order!!! -! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo - - ! Store the initial mechanical TKE and convectively released PE to - ! enable multiple iterations. - mech_TKE_top(i) = mech_TKE(i) ; conv_PErel_top(i) = conv_PErel(i) - - !/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(i,k)*GV%H_to_Z ; enddo - min_MLD = 0.0 !min_MLD will initialize as 0. - !/BGR: May add user-input bounds for max/min MLD - - !/BGR: Add MLD_guess based on stored previous value. - ! note that this is different from ML_Depth already - ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then - !If prev value is present use for guess. - MLD_guess = CS%ML_Depth2(i,j) - else - !Otherwise guess middle of water column (or Stab_Scale if smaller). - MLD_guess = 0.5 * (min_MLD+max_MLD) + if (debug) then + mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel + nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 endif - ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. - OBL_CONVERGED = .false. - - ! Initialize ENHANCE_M to 1 and mstar_lt to 0 - ENHANCE_M=1.e0 - MSTAR_LT = 0.0 - do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then - - ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z - - sfc_connected(i) = .true. - - if (CS%Mstar_Mode > 0) then - ! Note the value of mech_TKE(i) now must be iterated over, so it is moved here - ! First solve for the TKE to PE length scale - if (CS%MSTAR_MODE == CS%MLD_o_OBUKHOV) then - MLD_over_Stab = MLD_guess / Stab_Scale - CS%MSTAR_XINT - !### MLD_over_Stab = (MLD_guess * (VonKar * (C_MO*BF_Stable - C_EK*U_star**2*absf(i)))) / & - !### U_star**3 - CS%MSTAR_XINT - if ((MLD_over_Stab) <= 0.0) then - !Asymptote to 0 as MLD_over_Stab -> -infinity (always) - MSTAR_mix = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%MSTAR_N) - else - if (CS%MSTAR_CAP>=0.) then - if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then - !If using flat cap (or if using asymptotic cap - ! but within linear regime we can make use of same code) - MSTAR_mix = min(CS%MSTAR_CAP, & - CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) - else - !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity - MSTAR_mix = CS%MSTAR_CAP - & - (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& - +CS%MSTAR_A2)**(CS%MSTAR_N) - endif - else - !No cap if negative cap value given. - MSTAR_mix = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT - endif - endif - elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then - !### Please refrain from using the construct A / B / C in place of A/(B*C). - ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) - mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) - !### Should be mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / (U_star**2 * (absf(i)+1.e-10))) - ! The limit for rotation (Ekman length) limited mixin - mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) - !### Consider rewriting the expression for mstar_ROT as: - ! mstar_Rot = 0.0 - ! if (Ustar > absf(i) * MLD_guess) & - ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) - ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. - MSTAR_MIX = max(mstar_STAB, min(1.25, mstar_ROT)) - if (CS%MSTAR_CAP > 0.0) MSTAR_MIX = min(CS%MSTAR_CAP, MSTAR_MIX) - elseif (CS%MSTAR_MODE.eq.CS%MSTAR_RH18) then - MSTAR_ROT = CS%RH18_MST_CN1 * ( 1.0 - ( 1.+CS%RH18_MST_CN2 * & - exp( CS%RH18_MST_CN3 * MLD_GUESS * absf(i) / u_star) )**-1.0 ) - MSTAR_STAB = CS%RH18_MST_CS1 * (bf_stable**2*MLD_GUESS & - / ( u_star**5 * absf(i) ) ) **CS%RH18_MST_CS2 - MSTAR_MIX = MSTAR_ROT + MSTAR_STAB - endif!mstar_mode==1 or ==2 or ==3 - ! Adjustment for unstable buoyancy flux. - ! Convection reduces mechanical mixing because there - ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & - ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & - 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) - ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & - ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & - ! 2.0*MSTAR_MIX * U_star**3 ) - if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) - ! 2. Get parameters for modified LA - MLD_o_Ekman = abs(MLD_guess * iL_Ekman) - MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) - ! 3. Adjust LA based on various parameters. - ! Assumes linear factors based on length scale ratios to adjust LA - ! Note when these coefficients are set to 0 recovers simple LA. - LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & - CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & - CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & - CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & - CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) - if (CS%LT_Enhance_Form==1) then - !Original w'/ust scaling w/ Van Roekel et al. 2012 scaling - ! NOTE we know now that this is not the right way to scale M. - ENHANCE_M = (1. + (1.4*LA)**(-2) + (5.4*LA)**(-4))**(1.5) - elseif (CS%LT_Enhance_Form==2) then - ! Enhancement is multiplied (added mst_lt set to 0) - ENHANCE_M = min(CS%Max_Enhance_M, (1. + CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) - MSTAR_LT = 0.0 - elseif (CS%LT_ENHANCE_Form == 3) then - ! or Enhancement is additive (multiplied enhance_m set to 1) - MSTAR_LT = CS%LT_ENHANCE_COEF * LAmod**CS%LT_ENHANCE_EXP - ENHANCE_M = 1.0 - endif - endif - !Reset mech_tke and conv_perel values (based on new mstar) - mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & - US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - conv_PErel(i) = 0.0 - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif - - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 - else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) - endif - else - mech_TKE(i) = mech_TKE_top(i)*ENHANCE_M ; conv_PErel(i) = conv_PErel_top(i) + do K=2,nz + ! Apply dissipation to the TKE, here applied as an exponential decay + ! due to 3-d turbulent energy being lost to inefficient rotational modes. + + ! There should be several different "flavors" of TKE that decay at + ! 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 + exp_kh = 1.0 + if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) + if (CS%TKE_diagnostics) & + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag + mech_TKE = mech_TKE * exp_kh + + ! Accumulate any convectively released potential energy to contribute + ! to wstar and to drive penetrating convection. + if (TKE_forcing(k) > 0.0) then + conv_PErel = conv_PErel + TKE_forcing(k) + if (CS%TKE_diagnostics) & + eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * I_dtdiag endif - if (CS%TKE_diagnostics) then - dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 - dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 + if (debug) then + mech_TKE_k(K) = mech_TKE ; conv_PErel_k(K) = conv_PErel endif - ! Store in 1D arrays cleared out each iteration. Only write in - ! 3D arrays after convergence. - do k=1,nz - Vstar_Used(k) = 0.0 ; Mixing_Length_Used(k) = 0.0 - enddo - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. - - if ((.not.CS%Use_MLD_Iteration) .or. & - (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then - do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo - elseif (MLD_guess <= 0.0) then - if (CS%transLay_scale > 0.0) then - do K=1,nz+1 ; MixLen_shape(K) = CS%transLay_scale ; enddo - else - do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo - endif - else - ! Reduce the mixing length based on MLD, with a quadratic - ! expression that follows KPP. - I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0 - MixLen_shape(1) = 1.0 - do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z - 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 - else - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent - endif - enddo + ! Determine the total energy + nstar_FC = CS%nstar + 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)) endif + if (debug) nstar_k(K) = nstar_FC - Kd(i,1) = 0.0 ; Kddt_h(1) = 0.0 - hp_a(i) = h(i,1) - dT_to_dPE_a(i,1) = dT_to_dPE(i,1) ; dT_to_dColHt_a(i,1) = dT_to_dColHt(i,1) - dS_to_dPE_a(i,1) = dS_to_dPE(i,1) ; dS_to_dColHt_a(i,1) = dS_to_dColHt(i,1) + tot_TKE = mech_TKE + nstar_FC * conv_PErel - htot(i) = h(i,1) ; uhtot(i) = u(i,1)*h(i,1) ; vhtot(i) = v(i,1)*h(i,1) + ! For each interior interface, first discard the TKE to account for + ! mixing of shortwave radiation through the next denser cell. + if (TKE_forcing(k) < 0.0) then + if (TKE_forcing(k) + tot_TKE < 0.0) then + ! The shortwave requirements deplete all the energy in this layer. + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * I_dtdiag + eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * I_dtdiag + ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag + endif + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + else + ! Reduce the mechanical and convective TKE proportionately. + TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * I_dtdiag + eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag + endif + tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) + mech_TKE = TKE_reduc*mech_TKE + conv_PErel = TKE_reduc*conv_PErel + endif + endif - if (debug) then - mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) - nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 + ! Precalculate some temporary expressions that are independent of Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + 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)) + endif endif - do K=2,nz - ! Apply dissipation to the TKE, here applied as an exponential decay - ! due to 3-d turbulent energy being lost to inefficient rotational modes. - - ! There should be several different "flavors" of TKE that decay at - ! 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(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z - exp_kh = 1.0 - if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) - if (CS%TKE_diagnostics) & - dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE(i) * IdtdR0 - mech_TKE(i) = mech_TKE(i) * exp_kh - - ! Accumulate any convectively released potential energy to contribute - ! to wstar and to drive penetrating convection. - if (TKE_forced(i,j,k) > 0.0) then - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,k) - if (CS%TKE_diagnostics) & - dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forced(i,j,k) * IdtdR0 + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) + + ! This tests whether the layers above and below this interface are in + ! a convetively stable configuration, without considering any effects of + ! mixing at higher interfaces. It is an approximation to the more + ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of + ! mixing across interface K-1. The dT_to_dColHt here are effectively + ! mass-weigted estimates of dSV_dT. + Convectively_stable = ( 0.0 <= & + ( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + & + (dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) ) + + if ((mech_TKE + conv_PErel) <= 0.0 .and. Convectively_stable) then + ! Energy is already exhausted, so set Kd = 0 and cycle or exit? + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + sfc_disconnect = .true. + ! if (.not.debug) exit + + ! The estimated properties for layer k-1 can be calculated, using + ! greatly simplified expressions when Kddt_h = 0. This enables the + ! tridiagonal solver for the whole column to be completed for debugging + ! purposes, and also allows for something akin to convective adjustment + ! in unstable interior regions? + b1 = 1.0 / hp_a + c1(K) = 0.0 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( dTe_t2 ) + dSe(k-1) = b1 * ( dSe_t2 ) endif - if (debug) then - mech_TKE_k(i,K) = mech_TKE(i) ; conv_PErel_k(i,K) = conv_PErel(i) + hp_a = h(k) + dT_to_dPE_a(k) = dT_to_dPE(k) + dS_to_dPE_a(k) = dS_to_dPE(k) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + + else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. + sfc_disconnect = .false. + + ! Precalculate some more temporary expressions that are independent of + ! Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + dT_km1_t2 = (T0(k)-T0(k-1)) + dS_km1_t2 = (S0(k)-S0(k-1)) + else + dT_km1_t2 = (T0(k)-T0(k-1)) - & + (Kddt_h(K-1) / hp_a) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dS_km1_t2 = (S0(k)-S0(k-1)) - & + (Kddt_h(K-1) / hp_a) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif + dTe_term = dTe_t2 + hp_a * (T0(k-1)-T0(k)) + dSe_term = dSe_t2 + hp_a * (S0(k-1)-S0(k)) + else + if (K<=2) then + Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1) + else + Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) + Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) + endif + Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k) endif - ! Determine the total energy - nstar_FC = CS%nstar - if (CS%nstar * conv_PErel(i) > 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(i))**3 / conv_PErel(i)) - nstar_FC = CS%nstar * conv_PErel(i) / (conv_PErel(i) + 0.2 * & - sqrt(0.5 * dt * GV%Rho0 * (absf(i)*(htot(i)*GV%H_to_m))**3 * conv_PErel(i))) + ! Using Pr=1 and the diffusivity at the bottom interface (once it is + ! known), determine how much resolved mean kinetic energy (MKE) will be + ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of + ! this to the mTKE budget available for mixing in the next layer. + + if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then + ! This is the energy that would be available from homogenizing the + ! velocities between layer k and the layers above. + dMKE_max = (US%L_to_Z**2*US%m_to_Z*GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + (h(k) / ((htot + h(k))*htot)) * & + ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) + ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be + ! extracted by mixing with a finite viscosity. + MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / & + ((htot+h_neglect) * (h(k)+h_neglect)) + else + dMKE_max = 0.0 + MKE2_Hharm = 0.0 endif - if (debug) nstar_k(K) = nstar_FC - - tot_TKE = mech_TKE(i) + nstar_FC * conv_PErel(i) - - ! For each interior interface, first discard the TKE to account for - ! mixing of shortwave radiation through the next denser cell. - if (TKE_forced(i,j,k) < 0.0) then - if (TKE_forced(i,j,k) + tot_TKE < 0.0) then - ! The shortwave requirements deplete all the energy in this layer. - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 - dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 - ! dTKE_unbalanced_forcing = dTKE_unbalanced_forcing + & - ! (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 - endif - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + ! 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 + 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 + elseif (CS%wT_scheme==wT_from_RH18) then + Surface_Scale = max(0.05, 1.0 - htot/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) + 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)) + !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) else - ! Reduce the mechanical and convective TKE proportionately. - TKE_reduc = (tot_TKE + TKE_forced(i,j,k)) / tot_TKE - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - TKE_forced(i,j,k) * IdtdR0 - dTKE_forcing = dTKE_forcing + TKE_forced(i,j,k) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 - endif - tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forced(i,j,k) - mech_TKE(i) = TKE_reduc*mech_TKE(i) - conv_PErel(i) = TKE_reduc*conv_PErel(i) + Kd_guess0 = vstar * CS%vonKar * mixlen(K) endif + else + vstar = 0.0 ; Kd_guess0 = 0.0 endif + mixvel(K) = vstar ! Track vstar + Kddt_h_g0 = Kd_guess0 * dt_h - ! Precalculate some temporary expressions that are independent of Kddt_h(K). if (CS%orig_PE_calc) then - if (K==2) then - 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)) - endif + call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a, 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_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) + else + call find_PE_chg(0.0, Kddt_h_g0, hp_a, h(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(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) endif - dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) - - ! This tests whether the layers above and below this interface are in - ! a convetively stable configuration, without considering any effects of - ! mixing at higher interfaces. It is an approximation to the more - ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of - ! mixing across interface K-1. The dT_to_dColHt here are effectively - ! mass-weigted estimates of dSV_dT. - Convectively_stable = ( 0.0 <= & - ( (dT_to_dColHt(i,k) + dT_to_dColHt(i,k-1) ) * (T0(k-1)-T0(k)) + & - (dS_to_dColHt(i,k) + dS_to_dColHt(i,k-1) ) * (S0(k-1)-S0(k)) ) ) - - if ((mech_TKE(i) + conv_PErel(i)) <= 0.0 .and. Convectively_stable) then - ! Energy is already exhausted, so set Kd = 0 and cycle or exit? - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 - sfc_disconnect = .true. - ! if (.not.debug) exit - - ! The estimated properties for layer k-1 can be calculated, using - ! greatly simplified expressions when Kddt_h = 0. This enables the - ! tridiagonal solver for the whole column to be completed for debugging - ! purposes, and also allows for something akin to convective adjustment - ! in unstable interior regions? - b1 = 1.0 / hp_a(i) - c1(K) = 0.0 - if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( dTe_t2 ) - dSe(k-1) = b1 * ( dSe_t2 ) - endif - hp_a(i) = h(i,k) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) - - else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. - sfc_disconnect = .false. - - ! Precalculate some more temporary expressions that are independent of - ! Kddt_h(K). - if (CS%orig_PE_calc) then - if (K==2) then - dT_km1_t2 = (T0(k)-T0(k-1)) - dS_km1_t2 = (S0(k)-S0(k-1)) + MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) + + ! This block checks out different cases to determine Kd at the present interface. + if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then + ! This column is convectively unstable. + if (PE_chg_max <= 0.0) then + ! Does MKE_src need to be included in the calculation of vstar here? + 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 + elseif (CS%wT_scheme==wT_from_RH18) then + Surface_Scale = max(0.05, 1. - htot/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) + 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)) + 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) + else + Kd(K) = vstar * CS%vonKar * mixlen(K) + endif else - dT_km1_t2 = (T0(k)-T0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dS_km1_t2 = (S0(k)-S0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + vstar = 0.0 ; Kd(K) = 0.0 endif - dTe_term = dTe_t2 + hp_a(i) * (T0(k-1)-T0(k)) - dSe_term = dSe_t2 + hp_a(i) * (S0(k-1)-S0(k)) - else - if (K<=2) then - Th_a(k-1) = h(i,k-1) * T0(k-1) ; Sh_a(k-1) = h(i,k-1) * S0(k-1) + mixvel(K) = vstar + + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kd(K)*dt_h, h(k), hp_a, 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=dPE_conv) else - Th_a(k-1) = h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) - Sh_a(k-1) = h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) - endif - Th_b(k) = h(i,k) * T0(k) ; Sh_b(k) = h(i,k) * S0(k) - endif - - ! Using Pr=1 and the diffusivity at the bottom interface (once it is - ! known), determine how much resolved mean kinetic energy (MKE) will be - ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of - ! this to the mTKE budget available for mixing in the next layer. - - if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot(i)*h(i,k) > 0.0)) then - ! This is the energy that would be available from homogenizing the - ! velocities between layer k and the layers above. - dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & - (h(i,k) / ((htot(i) + h(i,k))*htot(i))) * & - ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) - ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be - ! extracted by mixing with a finite viscosity. - MKE2_Hharm = (htot(i) + h(i,k) + 2.0*h_neglect) / & - ((htot(i)+h_neglect) * (h(i,k)+h_neglect)) - else - dMKE_max = 0.0 ; MKE2_Hharm = 0.0 - endif - - ! 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(i) + h_tt_min - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) - if (TKE_here > 0.0) then - if (CS%vstar_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%vstar_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) - vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & - Surface_Scale + call find_PE_chg(0.0, Kd(K)*dt_h, hp_a, h(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(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=dPE_conv) endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) - !Note setting Kd_guess0 to Mixing_Length_Used(K) here will - ! change the answers. Therefore, skipping that. - if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + ! Should this be iterated to convergence for Kd? + if (dPE_conv > 0.0) then + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 else - Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) - endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function + MKE_src = dMKE_max*(1.0 - exp(-(Kd(K)*dt_h) * MKE2_Hharm)) endif else - vstar = 0.0 ; Kd_guess0 = 0.0 - endif - Vstar_Used(k) = vstar ! Track vstar - Kddt_h_g0 = Kd_guess0*dt_h - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) - else - call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) + ! The energy change does not vary monotonically with Kddt_h. Find the maximum? + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 endif - MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) + conv_PErel = conv_PErel - dPE_conv + mech_TKE = mech_TKE + MKE_src + if (CS%TKE_diagnostics) then + eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag + endif + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) + endif - if (pe_chg_g0 > 0.0) then - !Negative buoyancy (increases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_NEG - else - !Positive buoyancy (decreases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_POS + Kddt_h(K) = Kd(K) * dt_h + elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then + ! This column is convctively stable and there is energy to support the suggested + ! mixing. Keep that estimate. + Kd(K) = Kd_guess0 + Kddt_h(K) = Kddt_h_g0 + + ! Reduce the mechanical and convective TKE proportionately. + tot_TKE = tot_TKE + MKE_src + TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. + if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag + endif + tot_TKE = TKE_reduc*tot_TKE + mech_TKE = TKE_reduc*(mech_TKE + MKE_src) + conv_PErel = TKE_reduc*conv_PErel + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) endif - if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then - ! This column is convectively unstable. - if (PE_chg_max <= 0.0) then - ! Does MKE_src need to be included in the calculation of vstar here? - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) - if (TKE_here > 0.0) then - if (CS%vstar_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%vstar_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) - vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & - Surface_Scale - endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) - if (.not.CS%Use_MLD_Iteration) then - ! Note again (as prev) that using Mixing_Length_Used here - ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) - else - Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) - endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function - endif - else - vstar = 0.0 ; Kd(i,k) = 0.0 - endif - Vstar_Used(k) = vstar - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kd(i,k)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=dPE_conv) - else - call find_PE_chg(0.0, Kd(i,k)*dt_h, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) - endif - ! Should this be iterated to convergence for Kd? - if (dPE_conv > 0.0) then - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 - else - MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,k)*dt_h) * MKE2_Hharm)) - endif + elseif (tot_TKE == 0.0) then + ! This can arise if nstar_FC = 0, but it is not common. + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + tot_TKE = 0.0 ; conv_PErel = 0.0 ; mech_TKE = 0.0 + sfc_disconnect = .true. + else + ! There is not enough energy to support the mixing, so reduce the + ! diffusivity to what can be supported. + Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 + TKE_left_max = tot_TKE + (MKE_src - PE_chg_g0) + TKE_left_min = tot_TKE + + ! As a starting guess, take the minimum of a false position estimate + ! and a Newton's method estimate starting from Kddt_h = 0.0. + Kddt_h_guess = tot_TKE * Kddt_h_max / max( PE_chg_g0 - MKE_src, & + Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + ! The above expression is mathematically the same as the following + ! except it is not susceptible to division by zero when + ! dPEc_dKd_Kd0 = dMKE_max = 0 . + ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & + ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + if (debug) then + TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 + MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 + endif + do itt=1,max_itt + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kddt_h_guess, h(k), hp_a, 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, dPEc_dKd=dPEc_dKd ) else - ! The energy change does not vary monotonically with Kddt_h. Find the maximum? - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 - endif - conv_PErel(i) = conv_PErel(i) - dPE_conv - mech_TKE(i) = mech_TKE(i) + MKE_src - if (CS%TKE_diagnostics) then - dTKE_conv = dTKE_conv - CS%nstar*dPE_conv * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - endif - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) - endif - - Kddt_h(K) = Kd(i,k)*dt_h - elseif (tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) >= 0.0) then - ! There is energy to support the suggested mixing. Keep that estimate. - Kd(i,k) = Kd_guess0 - Kddt_h(K) = Kddt_h_g0 - - ! Reduce the mechanical and convective TKE proportionately. - tot_TKE = tot_TKE + MKE_src - TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. - if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - N2_DISSIPATION*PE_chg_g0) & - / tot_TKE - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + call find_PE_chg(0.0, Kddt_h_guess, hp_a, h(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(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=dPE_conv) endif - tot_TKE = TKE_reduc*tot_TKE - mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) - conv_PErel(i) = TKE_reduc*conv_PErel(i) - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) + MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) + dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) + + TKE_left = tot_TKE + (MKE_src - PE_chg) + if (debug .and. itt<=20) then + Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src + PE_chg_itt(itt) = PE_chg ; dPEa_dKd_itt(itt) = dPEc_dKd + TKE_left_itt(itt) = TKE_left endif - elseif (tot_TKE == 0.0) then - ! This can arise if nstar_FC = 0. - Kd(i,k) = 0.0 ; Kddt_h(K) = 0.0 - tot_TKE = 0.0 ; conv_PErel(i) = 0.0 ; mech_TKE(i) = 0.0 - sfc_disconnect = .true. - else - ! There is not enough energy to support the mixing, so reduce the - ! diffusivity to what can be supported. - Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 - TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) - TKE_left_min = tot_TKE - - ! As a starting guess, take the minimum of a false position estimate - ! and a Newton's method estimate starting from Kddt_h = 0.0. - Kddt_h_guess = tot_TKE * Kddt_h_max / max( N2_DISSIPATION*PE_chg_g0 & - - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * & - MKE2_Hharm) ) - ! The above expression is mathematically the same as the following - ! except it is not susceptible to division by zero when - ! dPEc_dKd_Kd0 = dMKE_max = 0 . - ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & - ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) - if (debug) then - TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 - MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 + ! Store the new bounding values, bearing in mind that min and max + ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: + if (TKE_left >= 0.0) then + Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left + else + Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left endif - do itt=1,max_itt - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_guess, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) - else - call find_PE_chg(0.0, Kddt_h_guess, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) - endif - MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) - dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) - - TKE_left = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg) - if (debug) then - Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src - PE_chg_itt(itt) = N2_DISSIPATION*PE_chg - TKE_left_itt(itt) = TKE_left - dPEa_dKd_itt(itt) = dPEc_dKd - endif - ! Store the new bounding values, bearing in mind that min and max - ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: - if (TKE_left >= 0.0) then - Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left - else - Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left - endif - ! Try to use Newton's method, but if it would go outside the bracketed - ! values use the false-position method instead. - use_Newt = .true. - if (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK <= 0.0) then + ! Try to use Newton's method, but if it would go outside the bracketed + ! values use the false-position method instead. + use_Newt = .true. + if (dPEc_dKd - dMKE_src_dK <= 0.0) then + use_Newt = .false. + else + dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK) + Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt + if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & use_Newt = .false. - else - dKddt_h_Newt = TKE_left / (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK) - Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt - if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & - use_Newt = .false. - endif - - if (use_Newt) then - Kddt_h_next = Kddt_h_guess + dKddt_h_Newt - dKddt_h = dKddt_h_Newt - else - Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & - (TKE_left_max - TKE_left_min) - dKddt_h = Kddt_h_next - Kddt_h_guess - endif + endif - if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then - ! Use the old value so that the energy calculation does not need to be repeated. - if (debug) num_itts(K) = itt - exit - else - Kddt_h_guess = Kddt_h_next - endif - enddo - Kd(i,K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(i,K)*dt_h - - ! All TKE should have been consumed. - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + if (use_Newt) then + Kddt_h_next = Kddt_h_guess + dKddt_h_Newt + dKddt_h = dKddt_h_Newt + else + Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & + (TKE_left_max - TKE_left_min) + dKddt_h = Kddt_h_next - Kddt_h_guess endif - if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - sfc_disconnect = .true. + if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then + ! Use the old value so that the energy calculation does not need to be repeated. + if (debug) num_itts(K) = itt + exit + else + Kddt_h_guess = Kddt_h_next + endif + enddo ! Inner iteration loop on itt. + Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K) * dt_h + + ! All TKE should have been consumed. + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag endif - Kddt_h(K) = Kd(i,K)*dt_h - ! At this point, the final value of Kddt_h(K) is known, so the - ! estimated properties for layer k-1 can be calculated. - b1 = 1.0 / (hp_a(i) + Kddt_h(K)) - c1(K) = Kddt_h(K) * b1 - if (CS%orig_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 + if (sfc_connected) MLD_output = MLD_output + & + (PE_chg / (PE_chg_g0)) * GV%H_to_Z * h(k) - hp_a(i) = h(i,k) + (hp_a(i) * b1) * Kddt_h(K) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) + c1(K)*dT_to_dPE_a(i,k-1) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) + c1(K)*dS_to_dPE_a(i,k-1) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) + c1(K)*dT_to_dColHt_a(i,k-1) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + c1(K)*dS_to_dColHt_a(i,k-1) - - endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. - - ! Store integrated velocities and thicknesses for MKE conversion calculations. - if (sfc_disconnect) then - ! There is no turbulence at this interface, so zero out the running sums. - uhtot(i) = u(i,k)*h(i,k) - vhtot(i) = v(i,k)*h(i,k) - htot(i) = h(i,k) - sfc_connected(i) = .false. - else - uhtot(i) = uhtot(i) + u(i,k)*h(i,k) - vhtot(i) = vhtot(i) + v(i,k)*h(i,k) - htot(i) = htot(i) + h(i,k) - endif + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + sfc_disconnect = .true. + endif ! End of convective or forced mixing cases to determine Kd. - if (debug) then - if (k==2) then - Te(1) = b1*(h(i,1)*T0(1)) - Se(1) = b1*(h(i,1)*S0(1)) - else - Te(k-1) = b1 * (h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) - Se(k-1) = b1 * (h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) - endif + Kddt_h(K) = Kd(K) * dt_h + ! At this point, the final value of Kddt_h(K) is known, so the + ! estimated properties for layer k-1 can be calculated. + b1 = 1.0 / (hp_a + Kddt_h(K)) + c1(K) = Kddt_h(K) * b1 + if (CS%orig_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 - enddo - Kd(i,nz+1) = 0.0 - if (debug) then - ! Complete the tridiagonal solve for Te. - b1 = 1.0 / hp_a(i) - Te(nz) = b1 * (h(i,nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) - Se(nz) = b1 * (h(i,nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - do k=nz-1,1,-1 - Te(k) = Te(k) + c1(K+1)*Te(k+1) - Se(k) = Se(k) + c1(K+1)*Se(k+1) - enddo - endif - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = Te(k) - T0(k) ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = Se(k) - S0(k) ; enddo + hp_a = h(k) + (hp_a * b1) * Kddt_h(K) + dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1) + dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1) + + endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. + + ! Store integrated velocities and thicknesses for MKE conversion calculations. + if (sfc_disconnect) then + ! There is no turbulence at this interface, so zero out the running sums. + uhtot = u(k)*h(k) + vhtot = v(k)*h(k) + htot = h(k) + sfc_connected = .false. + else + uhtot = uhtot + u(k)*h(k) + vhtot = vhtot + v(k)*h(k) + htot = htot + h(k) endif + if (debug) then - dPE_debug = 0.0 - do k=1,nz - dPE_debug = dPE_debug + (dT_to_dPE(i,k) * (Te(k) - T0(k)) + & - dS_to_dPE(i,k) * (Se(k) - S0(k))) - enddo - mixing_debug = dPE_debug * IdtdR0 - endif - k = nz ! This is here to allow a breakpoint to be set. - !/BGR - ! The following lines are used for the iteration - ! note the iteration has been altered to use the value predicted by - ! the TKE threshold (ML_DEPTH). This is because the MSTAR - ! is now dependent on the ML, and therefore the ML needs to be estimated - ! more precisely than the grid spacing. - !/ - ITmax(obl_it) = max_MLD ! Track max } - ITmin(obl_it) = min_MLD ! Track min } For debug purpose - ITguess(obl_it) = MLD_guess ! Track guess } - !/ - MLD_found = 0.0 ; FIRST_OBL = .true. - if (CS%Orig_MLD_iteration) then - !This is how the iteration was original conducted - do k=2,nz - if (FIRST_OBL) then !Breaks when OBL found - if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then - MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z - else - FIRST_OBL = .false. - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then - OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif - CS%ML_Depth2(i,j) = MLD_guess - else - max_MLD = MLD_guess !We know this guess was too deep - endif - endif - endif - enddo - else - !New method uses ML_DEPTH as computed in ePBL routine - MLD_found = CS%ML_Depth(i,j) - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then - OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif - CS%ML_Depth2(i,j) = MLD_guess + if (k==2) then + Te(1) = b1*(h(1)*T0(1)) + Se(1) = b1*(h(1)*S0(1)) else - max_MLD = MLD_guess !We know this guess was too deep + Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) + Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) endif endif - ! For next pass, guess average of minimum and maximum values. - MLD_guess = 0.5*(min_MLD + max_MLD) - ITresult(obl_it) = MLD_found - endif ; enddo ! Iteration loop for converged boundary layer thickness. - if (.not.OBL_CONVERGED) then - !/Temp output, warn that EPBL didn't converge - !/Print guess/found for every iteration step - !print*,'EPBL MLD DID NOT CONVERGE' - NOTCONVERGED=NOTCONVERGED+1 - !do obl_it=1,max_obl_it - ! print*,ITmin(obl_it),ITmax(obl_it) - ! print*,obl_it,ITguess(obl_it),ITresult(obl_it) - !enddo - !Activate to print out some output when not converged - !{ - !print*,'Min/Max: ',ITmin(50),ITmax(50) - !print*,'Guess/result: ',ITguess(50),ITresult(50) - !print*,'Stats on CPU: ',CONVERGED,NOTCONVERGED,& - ! real(NOTCONVERGED)/real(CONVERGED) - !} - !stop !Kill if not converged during testing. - else - CONVERGED=CONVERGED+1 - endif + enddo + Kd(nz+1) = 0.0 + + if (debug) then + ! Complete the tridiagonal solve for Te. + b1 = 1.0 / hp_a + Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) + Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) + eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) + do k=nz-1,1,-1 + Te(k) = Te(k) + c1(K+1)*Te(k+1) + Se(k) = Se(k) + c1(K+1)*Se(k+1) + eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) + enddo - if (CS%TKE_diagnostics) then - CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE - CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + dTKE_conv - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + dTKE_forcing - CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + dTKE_mixing - CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + dTKE_mech_decay - CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + dTKE_conv_decay - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced - endif - if (CS%Mixing_Diagnostics) then - !Write to 3-D for outputing Mixing length and - ! velocity scale. + dPE_debug = 0.0 do k=1,nz - CS%Mixing_Length(i,j,k) = Mixing_Length_Used(k) - CS%Velocity_Scale(i,j,k) = Vstar_Used(k) + dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & + dS_to_dPE(k) * (Se(k) - S0(k))) enddo + mixing_debug = dPE_debug * I_dtdiag endif - if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M - if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX - if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov - if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m) - if (allocated(CS%La)) CS%La(i,j) = LA - if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod - else ! End of the ocean-point part of the i-loop - ! For masked points, Kd_int must still be set (to 0) because it has intent out. - do K=1,nz+1 - Kd(i,K) = 0. - enddo - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo + k = nz ! This is here to allow a breakpoint to be set. + !/BGR + ! The following lines are used for the iteration + ! note the iteration has been altered to use the value predicted by + ! the TKE threshold (ML_DEPTH). This is because the MSTAR + ! is now dependent on the ML, and therefore the ML needs to be estimated + ! more precisely than the grid spacing. + + !New method uses ML_DEPTH as computed in ePBL routine + MLD_found = MLD_output + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then + OBL_converged = .true. ! Break convergence loop + else + max_MLD = MLD_guess ! We know this guess was too deep endif - endif ; enddo ! Close of i-loop - Note unusual loop order! - if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo - do k=2,nz ; do i=is,ie - if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z - enddo ; enddo + ! For next pass, guess average of minimum and maximum values. + !### We should try using the false position method instead of simple bisection. + MLD_guess = 0.5*(min_MLD + max_MLD) endif - - do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd(i,K) - enddo ; enddo - - enddo ! j-loop - - if (write_diags) then - if (CS%id_ML_depth > 0) & - call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) & - call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) & - call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) & - call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) & - call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) & - call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Hsfc_used > 0) & - call post_data(CS%id_Hsfc_used, Hsfc_used, CS%diag) - if (CS%id_Mixing_Length > 0) & - call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) & - call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_OSBL >0) & - call post_data(CS%id_OSBL, CS%ML_Depth2, CS%diag) - if (CS%id_LT_Enhancement >0) & - call post_data(CS%id_LT_Enhancement, CS%Enhance_M, CS%diag) - if (CS%id_MSTAR_MIX >0) & - call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_MLD_OBUKHOV >0) & - call post_data(CS%id_MLD_Obukhov, CS%MLD_OBUKHOV, CS%diag) - if (CS%id_MLD_EKMAN >0) & - call post_data(CS%id_MLD_Ekman, CS%MLD_EKMAN, CS%diag) - if (CS%id_Ekman_Obukhov >0) & - call post_data(CS%id_Ekman_Obukhov, CS%Ekman_Obukhov, CS%diag) - if (CS%id_LA >0) & - call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD >0) & - call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) & - call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + enddo ! Iteration loop for converged boundary layer thickness. + if (CS%Use_LT) then + eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT + else + eCD%LA = 0.0 ; eCD%LAmod = 0.0 ; eCD%mstar = mstar_total ; eCD%mstar_LT = 0.0 endif -end subroutine energetic_PBL + MLD_io = MLD_output + +end subroutine ePBL_column !> This subroutine calculates the change in potential energy and or derivatives !! for several changes in an interfaces's diapycnal diffusivity times a timestep. @@ -1641,27 +1463,27 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! above, including implicit mixing effects with other !! yet higher layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer - !! below, including implicit mixing effects with other + !! below, including implicit mixfing effects with other !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other !! yet lower layers [degC H ~> degC m or degC 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 [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 [kg m-3 Z3 T-2 degC-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 [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 [kg m-3 Z3 T-2 ppt-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 [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 [kg m-3 Z3 T-2 degC-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 [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 below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. @@ -1683,27 +1505,28 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [J m-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 realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [kg m-3 Z3 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 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [kg m-3 Z3 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 - !! change in the column height [J m-2]. + !! change in the column height [kg m-3 Z3 T-2 ~> J m-2]. 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 [degC H2 ~> degC m2 or degC kg2 m-4]. real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes [J m-3]. + ! for the potential energy changes [kg m-3 Z2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions - ! for the column height changes [J m-3]. + ! for the column height changes [H Z ~> m2 or kg m-1]. real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2]. - real :: y1 ! A local temporary term, [H-3 ~> m-3 or m6 kg-3] or [H-4 ~> m-4 or m8 kg-4] in various contexts. + 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]. ! The expression for the change in potential energy used here is derived ! from the expression for the final estimates of the changes in temperature @@ -1725,37 +1548,37 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & 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 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_chg = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + 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 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres_Z * min(ColHt_core * y1, 0.0) + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) endif if (present(dPEc_dKd)) then ! Find the derivative of the potential energy change with dKddt_h. - y1 = 1.0 / (bdt1 + dKddt_h * hps)**2 - dPEc_dKd = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / (bdt1 + dKddt_h * hps)**2 + dPEc_dKd = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg endif if (present(dPE_max)) then ! This expression is the limit of PE_chg for infinite dKddt_h. - y1 = 1.0 / (bdt1 * hps) - dPE_max = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = 1.0 / (bdt1 * hps) + dPE_max = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg endif if (present(dPEc_dKd_0)) then ! This expression is the limit of dPEc_dKd for dKddt_h = 0. - y1 = 1.0 / bdt1**2 - dPEc_dKd_0 = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / bdt1**2 + dPEc_dKd_0 = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg endif @@ -1789,25 +1612,25 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> 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 [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 [kg m-3 Z3 T-2 degC-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 [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! in the salinities of all the layers below [kg m-3 Z3 T-2 ppt-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 [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 [kg m-3 Z3 T-2 degC-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 [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 [kg m-3 Z3 T-2 ppt-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 degC-1 ~> m degC-1]. + !! height, including all implicit diffusive changes in the + !! temperatures of all the layers below [Z degC-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 @@ -1822,14 +1645,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h - !! [J m-2 H-1 ~> J m-3 or J kg-1]. + !! [kg m-3 Z3 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 realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [kg m-3 Z3 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 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [kg m-3 Z3 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 @@ -1916,13 +1739,184 @@ 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,& + BLD, Abs_Coriolis, MStar, Langmuir_Number,& + MStar_LT, Convect_Langmuir_Number) + type(energetic_PBL_CS), pointer :: 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) :: Abs_Coriolis !< abolute value of the Coriolis parameter [T-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: BLD !< boundary layer depth [Z ~> m] + real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim] + real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim] + real, optional, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] + real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] + + !/ Variables used in computing mstar + real :: MSN_term ! Temporary terms [nondim] + real :: MSCR_term1, MSCR_term2 ! Temporary terms [Z3 T-3 ~> m3 s-3] + real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing [nondim] + real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux [nondim] + + !/ Integer options for how to find mstar + + !/ + + if (CS%mstar_scheme == Use_Fixed_MStar) then + MStar = CS%Fixed_MStar + !/ 1. Get mstar + elseif (CS%mstar_scheme == MStar_from_Ekman) then + + if (CS%answers_2018) then + ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) + MStar_S = CS%MStar_coef*sqrt(max(0.0,Buoyancy_Flux) / Ustar**2 / & + (Abs_Coriolis + 1.e-10*US%T_to_s) ) + ! The limit for rotation (Ekman length) limited mixing + MStar_N = CS%C_Ek * log( max( 1., Ustar / (Abs_Coriolis + 1.e-10*US%T_to_s) / BLD ) ) + else + ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) + mstar_S = CS%MSTAR_COEF*sqrt(max(0.0, Buoyancy_Flux) / (Ustar**2 * max(Abs_Coriolis, 1.e-20*US%T_to_s))) + ! The limit for rotation (Ekman length) limited mixing + mstar_N = 0.0 + if (Ustar > Abs_Coriolis * BLD) mstar_N = CS%C_EK * log(Ustar / (Abs_Coriolis * BLD)) + endif + + ! Here 1.25 is about .5/von Karman, which gives the Obukhov limit. + MStar = max(MStar_S, min(1.25, MStar_N)) + if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) + elseif ( CS%mstar_scheme == MStar_from_RH18 ) then + if (CS%answers_2018) then + MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & + exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) + else + MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / Ustar) + MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) + endif + MStar_S = CS%RH18_MStar_CS1 * ( max(0.0, Buoyancy_Flux)**2 * BLD / & + ( Ustar**5 * max(Abs_Coriolis,1.e-20*US%T_to_s) ) )**CS%RH18_mstar_cs2 + MStar = MStar_N + MStar_S + endif + + !/ 2. Adjust mstar to account for convective turbulence + if (CS%answers_2018) then + MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) / & + ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) + & + 2.0 *MStar * Ustar**3 / BLD ) + else + MSCR_term1 = -BLD * min(0.0, Buoyancy_Flux) + MSCR_term2 = 2.0*MStar * Ustar**3 + MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) + endif + + !/3. Combine various mstar terms to get final value + MStar = MStar * MStar_Conv_Red + + if (present(Langmuir_Number)) then + !### In this call, ustar was previously ustar_mean. Is this change deliberate? + call mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_number, mstar, & + mstar_LT, Convect_Langmuir_Number) + endif + +end subroutine Find_Mstar + +!> This subroutine modifies the Mstar value if the Langmuir number is present +subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_Number, & + mstar, mstar_LT, Convect_Langmuir_Number) + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + 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) :: UStar !< Surface friction velocity with? gustiness [Z T-1 ~> m s-1] + real, intent(in) :: BLD !< boundary layer depth [Z ~> m] + real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim] + real, intent(in) :: Langmuir_Number !< Langmuir number [nondim] + real, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] + real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] + + !/ + real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. + real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence. + real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence. + real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. + real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. + real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1] + real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [T ~> s] + real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. + real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. + real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim]. + real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim]. + real :: Ekman_Obukhov_stab ! > + real :: MLD_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth + real :: Ekman_Obukhov_un ! > + + ! Set default values for no Langmuir effects. + enhance_mstar = 1.0 ; mstar_LT_add = 0.0 + + if (CS%LT_Enhance_Form /= No_Langmuir) then + ! a. Get parameters for modified LA + if (CS%answers_2018) then + iL_Ekman = Abs_Coriolis / Ustar + iL_Obukhov = Buoyancy_Flux*CS%vonkar / Ustar**3 + Ekman_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + Ekman_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + MLD_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) + MLD_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) + MLD_Ekman = abs( BLD*iL_Ekman ) + else + Ekman_Obukhov = Max_ratio ; MLD_Obukhov = Max_ratio ; MLD_Ekman = Max_ratio + I_f = 0.0 ; if (abs(abs_Coriolis) > 0.0) I_f = 1.0 / abs_Coriolis + I_ustar = 0.0 ; if (abs(Ustar) > 0.0) I_ustar = 1.0 / Ustar + if (abs(Buoyancy_Flux*CS%vonkar) < Max_ratio*(abs_Coriolis * Ustar**2)) & + Ekman_Obukhov = abs(Buoyancy_Flux*CS%vonkar) * (I_f * I_Ustar**2) + if (abs(BLD*Buoyancy_Flux*CS%vonkar) < Max_ratio*Ustar**3) & + MLD_Obukhov = abs(BLD*Buoyancy_Flux*CS%vonkar) * I_Ustar**3 + if (BLD*Abs_Coriolis < Max_ratio*Ustar) & + MLD_Ekman = BLD*Abs_Coriolis * I_Ustar + + if (Buoyancy_Flux > 0.0) then + Ekman_Obukhov_stab = Ekman_Obukhov ; Ekman_Obukhov_un = 0.0 + MLD_Obukhov_stab = MLD_Obukhov ; MLD_Obukhov_un = 0.0 + else + Ekman_Obukhov_un = Ekman_Obukhov ; Ekman_Obukhov_stab = 0.0 + MLD_Obukhov_un = MLD_Obukhov ; MLD_Obukhov_stab = 0.0 + endif + endif + + ! b. Adjust LA based on various parameters. + ! Assumes linear factors based on length scale ratios to adjust LA + ! Note when these coefficients are set to 0 recovers simple LA. + Convect_Langmuir_Number = Langmuir_Number * & + ( (1.0 + max(-0.5, CS%LaC_MLDoEK * MLD_Ekman)) + & + ((CS%LaC_EKoOB_stab * Ekman_Obukhov_stab + CS%LaC_EKoOB_un * Ekman_Obukhov_un) + & + (CS%LaC_MLDoOB_stab * MLD_Obukhov_stab + CS%LaC_MLDoOB_un * MLD_Obukhov_un)) ) + + if (CS%LT_Enhance_Form == Langmuir_rescale) then + ! Enhancement is multiplied (added mst_lt set to 0) + Enhance_mstar = min(CS%Max_Enhance_M, & + (1. + CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) + elseif (CS%LT_ENHANCE_Form == Langmuir_add) then + ! or Enhancement is additive (multiplied enhance_m set to 1) + mstar_LT_add = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP + endif + endif + + mstar_LT = (enhance_mstar - 1.0)*mstar + mstar_LT_add ! Diagnose the full increase in mstar. + mstar = mstar*enhance_mstar + mstar_LT_add + +end subroutine Mstar_Langmuir + + !> Copies the ePBL active mixed layer depth into MLD subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL 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 [m or other units] - real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD + real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the + !! desired units for MLD ! Local variables real :: scale ! A dimensional rescaling factor integer :: i,j @@ -1935,143 +1929,6 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) end subroutine energetic_PBL_get_MLD -!> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship -subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) - real, intent(in) :: USTair !< Ustar in the air [m s-1]. - 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, intent(out) :: U10 !< The 10 m wind speed [m s-1]. - - real, parameter :: vonkar = 0.4 - real, parameter :: nu=1e-6 - real :: z0sm, z0, z0rough, u10a, alpha, CD - integer :: CT - - ! Uses empirical formula for z0 to convert ustar_air to u10 based on the - ! COARE 3.5 paper (Edson et al., 2013) - !alpha=m*U10+b - !Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, - ! m=0.0017 reproduces the curve in their figure 6. - - z0sm = 0.11 * nu / USTair; !Compute z0smooth from ustar guess - u10 = USTair/sqrt(0.001); !Guess for u10 - u10a = 1000 - - CT=0 - do while (abs(u10a/u10-1.)>0.001) - CT=CT+1 - u10a = u10 - alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/(GV%g_Earth*US%m_to_Z) ! Compute z0rough from ustar guess - z0=z0sm+z0rough - CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness - u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop - ! ends and checks for convergence...CT counter - ! makes sure loop doesn't run away if function - ! doesn't converge. This code was produced offline - ! and converged rapidly (e.g. 2 cycles) - ! for ustar=0.0001:0.0001:10. - if (CT>20) then - u10 = USTair/sqrt(0.0015) ! I don't expect to get here, but just - ! in case it will output a reasonable value. - exit - endif - enddo - return -end subroutine ust_2_u10_coare3p5 - -!> This subroutine returns the Langmuir number, given ustar and the boundary -!! layer thickness, inclusion conversion to the 10m wind. -subroutine get_LA_windsea(ustar, hbl, GV, US, LA) - real, intent(in) :: ustar !< The water-side surface friction velocity [m s-1] - real, intent(in) :: hbl !< The ocean boundary layer depth [m] - 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, intent(out) :: LA !< The Langmuir number returned from this module -! Original description: -! This function returns the enhancement factor, given the 10-meter -! wind [m s-1], friction velocity [m s-1] and the boundary layer depth [m]. -! Update (Jan/25): -! Converted from function to subroutine, now returns Langmuir number. -! Computes 10m wind internally, so only ustar and hbl need passed to -! subroutine. -! -! Qing Li, 160606 -! BGR port from CVMix to MOM6 Jan/25/2017 -! BGR change output to LA from Efactor -! BGR remove u10 input - -! Input -! Local variables - ! parameters - real, parameter :: & - ! ratio of U19.5 to U10 (Holthuijsen, 2007) - u19p5_to_u10 = 1.075, & - ! ratio of mean frequency to peak frequency for - ! Pierson-Moskowitz spectrum (Webb, 2011) - fm_to_fp = 1.296, & - ! ratio of surface Stokes drift to U10 - us_to_u10 = 0.0162, & - ! loss ratio of Stokes transport - r_loss = 0.667 - real :: uStokes, hm0, fm, fp, vstokes, kphil, kstar - real :: z0, z0i, r1, r2, r3, r4, tmp, us_sl, lasl_sqr_i - real :: pi, u10 - pi = 4.0*atan(1.0) - if (ustar > 0.0) then - ! Computing u10 based on ustar and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV, US) - ! surface Stokes drift - uStokes = us_to_u10*u10 - - ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) - hm0 = 0.0246 *u10**2 - - ! peak frequency (PM, Bouws, 1998) - tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp - - ! mean frequency - fm = fm_to_fp * fp - - ! total Stokes transport (a factor r_loss is applied to account - ! for the effect of directional spreading, multidirectional waves - ! and the use of PM peak frequency and PM significant wave height - ! on estimating the Stokes transport) - vstokes = 0.125 * PI * r_loss * fm * hm0**2 - ! - ! the general peak wavenumber for Phillips' spectrum - ! (Breivik et al., 2016) with correction of directional spreading - kphil = 0.176 * uStokes / vstokes - ! - ! surface layer averaged Stokes dirft with Stokes drift profile - ! estimated from Phillips' spectrum (Breivik et al., 2016) - ! the directional spreading effect from Webb and Fox-Kemper, 2015 - ! is also included - kstar = kphil * 2.56 - ! surface layer - !z0 = 0.2 * abs(hbl) - !BGR hbl now adjusted by averaging ratio before function call. - z0 = abs(hbl) - z0i = 1.0 / z0 - ! term 1 to 4 - r1 = ( 0.151 / kphil * z0i -0.84 ) & - * ( 1.0 - exp(-2.0 * kphil * z0) ) - r2 = -( 0.84 + 0.0591 / kphil * z0i ) & - *sqrt( 2.0 * PI * kphil * z0 ) & - *erfc( sqrt( 2.0 * kphil * z0 ) ) - r3 = ( 0.0632 / kstar * z0i + 0.125 ) & - * (1.0 - exp(-2.0 * kstar * z0) ) - r4 = ( 0.125 + 0.0946 / kstar * z0i ) & - *sqrt( 2.0 * PI *kstar * z0) & - *erfc( sqrt( 2.0 * kstar * z0 ) ) - us_sl = uStokes * (0.715 + r1 + r2 + r3 + r4) - ! - LA = sqrt(ustar / us_sl) - else - LA=1.e8 - endif -endsubroutine Get_LA_windsea !> This subroutine initializes the energetic_PBL module subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) @@ -2087,14 +1944,18 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. + character(len=20) :: tmpstr real :: omega_frac_dflt + real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed + integer :: mstar_mode, LT_enhance, wT_mode + logical :: default_2018_answers logical :: use_temperature, use_omega logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"// & + call MOM_error(WARNING, "mixedlayer_init called with an associated"//& "associated control structure.") return else ; allocate(CS) ; endif @@ -2105,283 +1966,377 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & - "An integer switch for how to compute MSTAR. \n"//& - " 0 for constant MSTAR\n"//& - " 1 for MSTAR w/ MLD in stabilizing limit\n"//& - " 2 for MSTAR w/ L_E/L_O in stabilizing limit\n"//& - " 3 for MSTAR as in RH18.",& - "units=nondim",default=0) - call get_param(param_file, mdl, "MSTAR", CS%mstar, & - "The ratio of the friction velocity cubed to the TKE "//& - "input to the mixed layer.", "units=nondim", default=1.2) - call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & - "The exponent applied to the ratio of the distance to the MLD "//& - "and the MLD depth which determines the shape of the mixing length.",& - "units=nondim", default=2.0) - call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & - "Maximum value of mstar allowed in model if non-negative "//& - "(used if MSTAR_MODE>0).",& - "units=nondim", default=-1.0) - call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & - "Factor used for reducing mstar during convection "//& - "due to reduction of stable density gradient.",& - "units=nondim", default=0.0) - call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & - "The slope of the linear relationship between mstar "//& - "and the length scale ratio (used if MSTAR_MODE=1).",& - "units=nondim", default=0.85) - call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & - "The value of the length scale ratio where the mstar "//& - "is linear above (used if MSTAR_MODE=1).",& - "units=nondim", default=-0.3) - call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & - "The value of mstar at MSTAR_XINT "//& - "(used if MSTAR_MODE=1).",& - "units=nondim", default=0.095) - call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & - "Set false to use asymptotic cap, defaults to true. "//& - "(used only if MSTAR_MODE=1)"& - ,"units=nondim",default=.true.) - call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & - "Coefficient in computing mstar when rotation and "//& - "stabilizing effects are both important (used if MSTAR_MODE=2)"& - ,"units=nondim",default=0.3) - call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & - "Coefficient in computing mstar when only rotation limits "//& - "the total mixing. (used only if MSTAR_MODE=2)"& - ,"units=nondim",default=0.085) - call get_param(param_file, mdl, "RH18_MST_CN1", CS%RH18_MST_CN1,& - "MSTAR_N coefficient 1 (outter-most coefficient for fit). \n"//& - " The value of 0.275 is given in RH18. Increasing this \n"//& - "coefficient increases MSTAR for all values of Hf/ust, but more \n"//& - "effectively at low values (weakly developed OSBLs).",& - units="nondim", default=0.275) - call get_param(param_file, mdl, "RH18_MST_CN2", CS%RH18_MST_CN2,& - "MSTAR_N coefficient 2 (coefficient outside of exponential decay). \n"//& - "The value of 8.0 is given in RH18. Increasing this coefficient \n"//& - "increases MSTAR for all values of HF/ust, with a much more even \n"//& - "effect across a wide range of Hf/ust than CN1.",& - units="nondim",default=8.0) - call get_param(param_file, mdl, "RH18_MST_CN3", CS%RH18_MST_CN3,& - "MSTAR_N coefficient 3 (exponential decay coefficient). \n"//& - "The value of -5.0 is given in RH18. Increasing this increases how \n"//& - "quickly the value of MSTAR decreases as Hf/ust increases.",& - units="nondim",default=-5.0) - call get_param(param_file, mdl, "RH18_MST_CS1", CS%RH18_MST_CS1,& - "MSTAR_S coefficient for RH18 in stabilizing limit. \n"//& - "The value of 0.2 is given in RH18 and increasing it increases \n"//& - "MSTAR in the presence of a stabilizing surface buoyancy flux.",& - units="nondim",default=0.2) - call get_param(param_file, mdl, "RH18_MST_CS2", CS%RH18_MST_CS2,& - "MSTAR_S exponent for RH18 in stabilizing limit. \n"//& - "The value of 0.4 is given in RH18 and increasing it increases MSTAR \n"//& - "exponentially in the presence of a stabilizing surface buoyancy flux.",& - Units="nondim",default=0.4) - call get_param(param_file, mdl, "NSTAR", CS%nstar, & - "The portion of the buoyant potential energy imparted by "//& - "surface fluxes that is available to drive entrainment "//& - "at the base of mixed layer when that energy is positive.", & - units="nondim", default=0.2) - call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & - "The efficiency with which mean kinetic energy released "//& - "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy.", units="nondim", & - default=0.0) - call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & - "TKE_DECAY relates the vertical rate of decay of the "//& - "TKE available for mechanical entrainment to the natural "//& - "Ekman depth.", units="nondim", default=2.5) -! call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & -! "The minimum mixed layer depth if the mixed layer depth "//& -! "is determined dynamically.", units="m", default=0.0) - call get_param(param_file, mdl, "OMEGA",CS%omega, & +!/1. General ePBL settings + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) - call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & + default=7.2921e-5, scale=US%T_to_S) + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& - "vertical component of rotation when setting the decay "// & + "vertical component of rotation when setting the decay "//& "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & - "When setting the decay scale for turbulence, use this "// & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & + "When setting the decay scale for turbulence, use this "//& "fraction of the absolute rotation rate blended with the "//& - "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & + "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) - call get_param(param_file, mdl, "VSTAR_MODE", CS%vstar_mode, & - "An integer switch for how to compute VSTAR. \n"//& - " 0 for old vstar (TKE Remaining)^(1/3)\n"//& - " 1 for vstar from u* and w* (see Reichl & Hallberg 2018).",& - "units=nondim",default=0) - call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & - "A ratio relating the efficiency with which convectively "//& - "released energy is converted to a turbulent velocity, "// & - "relative to mechanically forced TKE. Making this larger "//& - "increases the BL diffusivity", units="nondim", default=1.0) - call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & - "An overall nondimensional scaling factor for v*. "// & - "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& - "The proportionality times ustar to set vstar to at the surface.",& - "units=nondim", default=1.2) - call get_param(param_file, mdl, "LT_ENHANCE_K_R16",CS%LT_ENH_K_R16, & - "Logical flag to toggle on enhancing mixing coefficient in\n"//& - "boundary layer due to Langmuir turbulence following Reichl\n"//& - "et al., 2016. \n"//& - "This approach is not recommended for use, as it is based\n"//& - "on a hurricane LES configuration and not known if it is general.",& - units="nondim",default=.false.) - call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & - "A nondimensional scaling factor controlling the inhibition "// & + call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & + "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) - call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & - "A logical that specifies whether or not to use the "// & + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "EPBL_2018_ANSWERS", CS%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) + + + 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 "//& + "potential energy change code. Otherwise, the newer "//& + "version that can work with successive increments to the "//& + "diffusivity in upward or downward passes is used.", default=.true.) + + call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & + "The efficiency with which mean kinetic energy released "//& + "by mechanically forced entrainment of the mixed layer "//& + "is converted to turbulent kinetic energy.", units="nondim", & + default=0.0) + call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & + "TKE_DECAY relates the vertical rate of decay of the "//& + "TKE available for mechanical entrainment to the natural "//& + "Ekman depth.", units="nondim", default=2.5) + + +!/2. Options related to setting MSTAR + call get_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & + "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& + "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & + default=CONSTANT_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "MSTAR_MODE", mstar_mode, default=-1) + if (mstar_mode == 0) then + tmpstr = CONSTANT_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = CONSTANT instead of the archaic MSTAR_MODE = 0.") + elseif (mstar_mode == 1) then + call MOM_error(FATAL, "You are using a legacy mstar mode in ePBL that has been phased out. "//& + "If you need to use this setting please report this error. Also use "//& + "EPBL_MSTAR_SCHEME to specify the scheme for mstar.") + elseif (mstar_mode == 2) then + tmpstr = OM4_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = OM4 instead of the archaic MSTAR_MODE = 2.") + elseif (mstar_mode == 3) then + tmpstr = RH18_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = REICHL_H18 instead of the archaic MSTAR_MODE = 3.") + elseif (mstar_mode > 3) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter MSTAR_MODE was specified.") + endif + call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & + "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& + "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & + default=CONSTANT_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (CONSTANT_STRING) + CS%mstar_Scheme = Use_Fixed_MStar + case (OM4_STRING) + CS%mstar_Scheme = MStar_from_Ekman + case (RH18_STRING) + CS%mstar_Scheme = MStar_from_RH18 + case default + call MOM_mesg('energetic_PBL_init: EPBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_MSTAR_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + + call get_param(param_file, mdl, "MSTAR", CS%fixed_mstar, & + "The ratio of the friction velocity cubed to the TKE input to the "//& + "mixed layer. This option is used if EPBL_MSTAR_SCHEME = CONSTANT.", & + units="nondim", default=1.2, do_not_log=(CS%mstar_scheme/=Use_Fixed_MStar)) + call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & + "If this value is positive, it sets the maximum value of mstar "//& + "allowed in ePBL. (This is not used if EPBL_MSTAR_SCHEME = CONSTANT).", & + units="nondim", default=-1.0, do_not_log=(CS%mstar_scheme==Use_Fixed_MStar)) + ! mstar_scheme==MStar_from_Ekman options + call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & + "Coefficient in computing mstar when rotation and stabilizing "//& + "effects are both important (used if EPBL_MSTAR_SCHEME = OM4).", & + units="nondim", default=0.3, do_not_log=(CS%mstar_scheme/=MStar_from_Ekman)) + call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & + "Coefficient in computing mstar when only rotation limits "// & + "the total mixing (used if EPBL_MSTAR_SCHEME = OM4)", & + units="nondim", default=0.085, do_not_log=(CS%mstar_scheme/=MStar_from_Ekman)) + ! mstar_scheme==MStar_from_RH18 options + call get_param(param_file, mdl, "RH18_MSTAR_CN1", CS%RH18_mstar_cn1,& + "MSTAR_N coefficient 1 (outter-most coefficient for fit). "//& + "The value of 0.275 is given in RH18. Increasing this "//& + "coefficient increases MSTAR for all values of Hf/ust, but more "//& + "effectively at low values (weakly developed OSBLs).", & + units="nondim", default=0.275, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CN2", CS%RH18_mstar_cn2,& + "MSTAR_N coefficient 2 (coefficient outside of exponential decay). "//& + "The value of 8.0 is given in RH18. Increasing this coefficient "//& + "increases MSTAR for all values of HF/ust, with a much more even "//& + "effect across a wide range of Hf/ust than CN1.", & + units="nondim", default=8.0, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CN3", CS%RH18_mstar_CN3,& + "MSTAR_N coefficient 3 (exponential decay coefficient). "//& + "The value of -5.0 is given in RH18. Increasing this increases how "//& + "quickly the value of MSTAR decreases as Hf/ust increases.", & + units="nondim", default=-5.0, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CS1", CS%RH18_mstar_cs1,& + "MSTAR_S coefficient for RH18 in stabilizing limit. "//& + "The value of 0.2 is given in RH18 and increasing it increases "//& + "MSTAR in the presence of a stabilizing surface buoyancy flux.", & + units="nondim", default=0.2, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CS2", CS%RH18_mstar_cs2,& + "MSTAR_S exponent for RH18 in stabilizing limit. "//& + "The value of 0.4 is given in RH18 and increasing it increases MSTAR "//& + "exponentially in the presence of a stabilizing surface buoyancy flux.", & + Units="nondim", default=0.4, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + + +!/ Convective turbulence related options + call get_param(param_file, mdl, "NSTAR", CS%nstar, & + "The portion of the buoyant potential energy imparted by "//& + "surface fluxes that is available to drive entrainment "//& + "at the base of mixed layer when that energy is positive.", & + units="nondim", default=0.2) + call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%mstar_convect_coef, & + "Coefficient used for reducing mstar during convection "//& + "due to reduction of stable density gradient.", & + units="nondim", default=0.0) + +!/ Mixing Length Options + !### THIS DEFAULT SHOULD BECOME TRUE. + call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%Use_MLD_iteration, & + "A logical that specifies whether or not to use the "//& "distance to the bottom of the actively turbulent boundary "//& "layer to help set the EPBL length scale.", default=.false.) - call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & - "A logical that specifies whether or not to use the "// & - "old method for determining MLD depth in iteration, which "//& - "is limited to resolution.", default=.true.) - call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & - "A logical that specifies whether or not to use the "// & - "previous timestep MLD as a first guess in the MLD iteration. "// & + call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & + "A scale for the mixing length in the transition layer "//& + "at the edge of the boundary layer as a fraction of the "//& + "boundary layer thickness.", units="nondim", default=0.1) + if ( CS%Use_MLD_iteration .and. abs(CS%transLay_scale-0.5) >= 0.5) then + call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "//& + "EPBL_TRANSITION should be greater than 0 and less than 1.") + endif + + call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & + "A logical that specifies whether or not to use the "//& + "previous timestep MLD as a first guess in the MLD iteration. "//& "The default is false to facilitate reproducibility.", default=.false.) - call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & - "The tolerance for the iteratively determined mixed "// & + 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=US%m_to_Z) - call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & + call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", CS%max_MLD_its, & + "The maximum number of iterations that can be used to find a self-consistent "//& + "mixed layer depth. For now, due to the use of bisection, the maximum number "//& + "iteractions needed is set by Depth/2^MAX_ITS < EPBL_MLD_TOLERANCE.", & + default=20, do_not_log=.not.CS%Use_MLD_iteration) + if (.not.CS%Use_MLD_iteration) CS%Max_MLD_Its = 1 + call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used "//& - "by ePBL. The default (0) does not set a minimum.", & + "by ePBL. The default (0) does not set a minimum.", & units="meter", default=0.0, scale=US%m_to_Z) - 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 "// & - "potential energy change code. Otherwise, the newer "// & - "version that can work with successive increments to the "// & - "diffusivity in upward or downward passes is used.", default=.true.) - call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & - "A scale for the mixing length in the transition layer "// & - "at the edge of the boundary layer as a fraction of the "//& - "boundary layer thickness. The default is 0.1.", & - units="nondim", default=0.1) - if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5) >= 0.5) then - call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & - "EPBL_TRANSITION should be greater than 0 and less than 1.") + + call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & + "The exponent applied to the ratio of the distance to the MLD "//& + "and the MLD depth which determines the shape of the mixing length. "//& + "This is only used if USE_MLD_ITERATION is True.", & + units="nondim", default=2.0) + +!/ Turbulent velocity scale in mixing coefficient + call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & + "Selects the method for translating TKE into turbulent velocities. "//& + "Valid values are: \n"//& + "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//& + "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//& + "\t documented in Reichl & Hallberg, 2018.", & + default=ROOT_TKE_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", wT_mode, default=-1) + if (wT_mode == 0) then + tmpstr = ROOT_TKE_STRING + call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = CUBE_ROOT_TKE instead of the archaic EPBL_VEL_SCALE_MODE = 0.") + elseif (wT_mode == 1) then + tmpstr = RH18_STRING + call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = REICHL_H18 instead of the archaic EPBL_VEL_SCALE_MODE = 1.") + elseif (wT_mode >= 2) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter EPBL_VEL_SCALE_MODE was specified.") endif - call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & - "A scale for the dissipation of TKE due to stratification "// & - "in the boundary layer, applied when local stratification "// & - "is positive. The default is 0, but should probably be ~0.4.", & - units="nondim", default=0.0) - call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& - "A scale for the dissipation of TKE due to stratification "// & - "in the boundary layer, applied when local stratification "// & - "is negative. The default is 0, but should probably be ~1.", & - units="nondim", default=0.0) - call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & + call log_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & + "Selects the method for translating TKE into turbulent velocities. "//& + "Valid values are: \n"//& + "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//& + "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//& + "\t documented in Reichl & Hallberg, 2018.", & + default=ROOT_TKE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (ROOT_TKE_STRING) + CS%wT_scheme = wT_from_cRoot_TKE + case (RH18_STRING) + CS%wT_scheme = wT_from_RH18 + case default + call MOM_mesg('energetic_PBL_init: EPBL_VEL_SCALE_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_VEL_SCALE_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + + call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & + "A ratio relating the efficiency with which convectively "//& + "released energy is converted to a turbulent velocity, "//& + "relative to mechanically forced TKE. Making this larger "//& + "increases the BL diffusivity", units="nondim", default=1.0) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, & + "An overall nondimensional scaling factor for wT. "//& + "Making this larger increases the PBL diffusivity.", & + units="nondim", default=1.0) + call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& + "The proportionality times ustar to set vstar at the surface.", & + units="nondim", default=1.2) + + !/ Options related to Langmuir turbulence + call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& "determine the Langmuir number.", units="nondim", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. - if (use_la_windsea) then + if (use_LA_windsea) then CS%USE_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & - "A logical to use a LT parameterization.", & - units="nondim", default=.false.) + "A logical to use a LT parameterization.", & + units="nondim", default=.false.) endif if (CS%USE_LT) then - call get_param(param_file, mdl, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & - "Integer for Langmuir number mode. \n"// & - " *Requires USE_LA_LI2016 to be set to True. \n"// & - "Options: 0 - No Langmuir \n"// & - " 1 - Van Roekel et al. 2014/Li et al., 2016 \n"// & - " 2 - Multiplied w/ adjusted La. \n"// & - " 3 - Added w/ adjusted La.", & - units="nondim", default=0) + call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & + "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& + "Valid values are: \n"//& + "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//& + "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//& + "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", & + default=NONE_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "LT_ENHANCE", LT_enhance, default=-1) + if (LT_ENHANCE == 0) then + tmpstr = NONE_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = NONE instead of the archaic LT_ENHANCE = 0.") + elseif (LT_ENHANCE == 1) then + call MOM_error(FATAL, "You are using a legacy LT_ENHANCE mode in ePBL that has been phased out. "//& + "If you need to use this setting please report this error. Also use "//& + "EPBL_LANGMUIR_SCHEME to specify the scheme for mstar.") + elseif (LT_ENHANCE == 2) then + tmpstr = RESCALED_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = RESCALE instead of the archaic LT_ENHANCE = 2.") + elseif (LT_ENHANCE == 3) then + tmpstr = ADDITIVE_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = ADDITIVE instead of the archaic LT_ENHANCE = 3.") + elseif (LT_ENHANCE > 3) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter LT_ENHANCE was specified.") + endif + call log_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & + "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& + "Valid values are: \n"//& + "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//& + "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//& + "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", & + default=NONE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (NONE_STRING) + CS%LT_enhance_form = No_Langmuir + case (RESCALED_STRING) + CS%LT_enhance_form = Langmuir_rescale + case (ADDITIVE_STRING) + CS%LT_enhance_form = Langmuir_add + case default + call MOM_mesg('energetic_PBL_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_LANGMUIR_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & - "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=0.447) + "Coefficient for Langmuir enhancement of mstar", & + units="nondim", default=0.447, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & - "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=-1.33) - call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching Ekman depth if LT_ENHANCE=2.", & - units="nondim", default=-0.87) + "Exponent for Langmuir enhancementt of mstar", & + units="nondim", default=-1.33, do_not_log=(CS%LT_enhance_form==No_Langmuir)) + call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching Ekman depth.", & + units="nondim", default=-0.87, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & - "Coefficient for modification of Langmuir number due to "// & - "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching stable Obukhov depth.", & + units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching unstable Obukhov depth.", & + units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & - "Coefficient for modification of Langmuir number due to "// & - "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.95) - call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & - "Coefficient for modification of Langmuir number due to "// & - "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& - units="nondim", default=0.95) + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to stable Obukhov depth.", & + units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir)) + call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to unstable Obukhov depth.", & + units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir)) endif + + +!/ 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) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m, & + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & "The (tiny) minimum friction velocity used within the "//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") + +!/ Checking output flags + Z3_T3_to_m3_s3 = US%Z_to_m**3 * US%s_to_T**3 CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3') + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3') + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, & Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//& - 'through model layers', 'm3 s-3') + 'through model layers', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') - CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=US%m_to_Z) + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m) - CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & - Time, 'LT enhancement that is used.', 'nondim') + Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & - Time, 'MSTAR that is used.', 'nondim') - CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=US%m_to_Z) - ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is - ! result from iteration step. - CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & - Time, 'Boundary layer depth over Ekman length.', 'm') - CS%id_mld_obukhov = register_diag_field('ocean_model', 'MLD_OBUKHOV', diag%axesT1, & - Time, 'Boundary layer depth over Obukhov length.', 'm') - CS%id_ekman_obukhov = register_diag_field('ocean_model', 'EKMAN_OBUKHOV', diag%axesT1, & - Time, 'Ekman length over Obukhov length.', 'm') - CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & - Time, 'Langmuir number.', 'nondim') - CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & - Time, 'Modified Langmuir number.', 'nondim') - CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & - Time, 'MSTAR applied for LT effect.', 'nondim') + Time, 'Total mstar that is used.', 'nondim') + + if (CS%use_LT) then + CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & + Time, 'Langmuir number.', 'nondim') + CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & + Time, 'Modified Langmuir number.', 'nondim') + CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & + Time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim') + endif call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state "//& @@ -2400,38 +2355,17 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%TKE_diagnostics = .true. endif - if ((CS%id_Mixing_Length>0) .or. (CS%id_Velocity_Scale>0)) then - call safe_alloc_alloc(CS%Velocity_Scale,isd,ied,jsd,jed,GV%ke+1) - call safe_alloc_alloc(CS%Mixing_Length,isd,ied,jsd,jed,GV%ke+1) - CS%Velocity_Scale(:,:,:) = 0.0 - CS%Mixing_Length(:,:,:) = 0.0 - CS%mixing_diagnostics = .true. - endif + if (CS%id_Velocity_Scale>0) call safe_alloc_alloc(CS%Velocity_Scale, isd, ied, jsd, jed, GV%ke+1) + if (CS%id_Mixing_Length>0) call safe_alloc_alloc(CS%Mixing_Length, isd, ied, jsd, jed, GV%ke+1) + call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%ML_depth2, isd, ied, jsd, jed) - if (max(CS%id_LT_Enhancement, CS%id_mstar_mix,CS%id_mld_ekman, & - CS%id_ekman_obukhov, CS%id_mld_obukhov, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then + if (max(CS%id_mstar_mix, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then call safe_alloc_alloc(CS%Mstar_mix, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%Enhance_M, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%MLD_EKMAN, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%MLD_OBUKHOV, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%EKMAN_OBUKHOV, isd, ied, jsd, jed) call safe_alloc_alloc(CS%LA, isd, ied, jsd, jed) call safe_alloc_alloc(CS%LA_MOD, isd, ied, jsd, jed) call safe_alloc_alloc(CS%MSTAR_LT, isd, ied, jsd, jed) endif - !Fitting coefficients to asymptote twoard 0 as MLD -> Ekman depth - CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%MSTAR_N) - CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_N*CS%MSTAR_A**(CS%MSTAR_N-1.)) - !Fitting coefficients to asymptote toward MSTAR_CAP - !*Fixed to begin asymptote at MSTAR_CAP-0.5 toward MSTAR_CAP - CS%MSTAR_A2 = 0.5**(1./CS%MSTAR_N) - CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%MSTAR_N*CS%MSTAR_A2**(CS%MSTAR_N-1)) - !Compute value of X (referenced to MSTAR_XINT) where transition - ! to asymptotic regime based on value of X where MSTAR=MSTAR_CAP-0.5 - CS%MSTAR_XINT_UP = (CS%MSTAR_CAP-0.5-CS%MSTAR_AT_XINT)/CS%MSTAR_SLOPE - end subroutine energetic_PBL_init !> Clean up and deallocate memory associated with the energetic_PBL module. @@ -2442,11 +2376,6 @@ subroutine energetic_PBL_end(CS) if (.not.associated(CS)) return if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) - if (allocated(CS%ML_depth2)) deallocate(CS%ML_depth2) - if (allocated(CS%Enhance_M)) deallocate(CS%Enhance_M) - if (allocated(CS%MLD_EKMAN)) deallocate(CS%MLD_EKMAN) - if (allocated(CS%MLD_OBUKHOV)) deallocate(CS%MLD_OBUKHOV) - if (allocated(CS%EKMAN_OBUKHOV)) deallocate(CS%EKMAN_OBUKHOV) if (allocated(CS%LA)) deallocate(CS%LA) if (allocated(CS%LA_MOD)) deallocate(CS%LA_MOD) if (allocated(CS%MSTAR_MIX)) deallocate(CS%MSTAR_MIX) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 34b48257bb..a4d8e985cf 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -48,15 +48,11 @@ module MOM_entrain_diffusive !! the buoyancy flux in a layer and inversely proportional to the density !! differences between layers. The scheme that is used here is described in !! detail in Hallberg, Mon. Wea. Rev. 2000. -subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & +subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & kb_out, 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -64,7 +60,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, !! ptrs. type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. - real, intent(in) :: dt !< The time increment [s]. + real, intent(in) :: dt !< The time increment [T ~> s]. type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -113,7 +109,7 @@ subroutine entrainment_diffusive(u, v, 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 s-1 ~> m2 s-1]. + ! considered [Z2 T-1 ~> m2 s-1]. diff_work ! The work actually done by diffusion across each ! interface [W m-2]. Sum vertically for the total work. @@ -175,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface [kg m-3]. real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors - ! [m3 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. + ! [m3 H-2 s-2 T-1 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -197,7 +193,7 @@ subroutine entrainment_diffusive(u, v, 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 [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -271,25 +267,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_lay(i,j,k))) + dtKd(i,k) = GV%Z_to_H**2 * (dt * Kd_lay(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 * (US%s_to_T * Kd_int(i,j,K))) + 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 & - * (US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)))) + 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 k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt & - * (US%T_to_s * (Kd_int(i,j,K)+Kd_int(i,j,K+1)))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt * (Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%T_to_s * Kd_int(i,j,K))) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) enddo ; enddo endif @@ -828,7 +822,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, endif if (CS%id_diff_work > 0) then - g_2dt = 0.5 * GV%H_to_Z**2 * (GV%g_Earth / dt) + g_2dt = 0.5 * GV%H_to_Z**2*US%L_to_Z**2 * (GV%g_Earth / dt) 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 @@ -2132,9 +2126,10 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z_to_m**2) + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m) + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', & + conversion=US%Z_to_m**3*US%s_to_T**3) end subroutine entrain_diffusive_init diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 15f1116190..d3d0f2bc6e 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -35,6 +35,10 @@ module MOM_geothermal type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. + integer :: id_internal_heat_heat_tendency = -1 !< ID for diagnostic of heat tendency + integer :: id_internal_heat_temp_tendency = -1 !< ID for diagnostic of temperature tendency + integer :: id_internal_heat_h_tendency = -1 !< ID for diagnostic of thickness tendency + end type geothermal_CS contains @@ -100,11 +104,22 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) real :: Irho_cp ! inverse of heat capacity per unit layer volume ! [degC H m2 J-1 ~> degC m3 J-1 or degC kg J-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_old ! Temperature of each layer + ! before any heat is added, + ! for diagnostics [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_old ! Thickness of each layer + ! before any heat is added, + ! for diagnostics [m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d ! Scratch variable used to + ! calculate change in heat + ! due to geothermal + real :: Idt ! inverse of the timestep [s-1] + logical :: do_i(SZI_(G)) + logical :: compute_h_old, compute_T_old integer :: i, j, k, is, ie, js, je, nz, k2, i2 integer :: isj, iej, num_start, num_left, nkmb, k_tgt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo @@ -119,6 +134,7 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) Angstrom = GV%Angstrom_H H_neglect = GV%H_subroundoff p_ref(:) = tv%P_Ref + Idt = 1.0 / dt if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal: "//& "Geothermal heating can only be applied if T & S are state variables.") @@ -136,6 +152,18 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) !$OMP wt_in_place,dTemp,dRcv,h_transfer,heating, & !$OMP I_h) + ! Conditionals for tracking diagnostic depdendencies + compute_h_old = CS%id_internal_heat_h_tendency > 0 & + .or. CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 + + compute_T_old = CS%id_internal_heat_heat_tendency > 0 & + .or. CS%id_internal_heat_temp_tendency > 0 + + if (CS%id_internal_heat_heat_tendency > 0) work_3d(:,:,:) = 0.0 + if (compute_h_old) h_old(:,:,:) = 0.0 + if (compute_T_old) T_old(:,:,:) = 0.0 + do j=js,je ! 1. Only work on columns that are being heated. ! 2. Find the deepest layer with any mass. @@ -175,6 +203,14 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) do k=nz,1,-1 do i=isj,iej ; if (do_i(i)) then + ! Save temperature and thickness before any changes are made (for diagnostic) + if (compute_h_old) then + h_old(i,j,k) = h(i,j,k) + endif + if (compute_T_old) then + T_old(i,j,k) = tv%T(i,j,k) + endif + if (h(i,j,k) > Angstrom) then if ((h(i,j,k)-Angstrom) >= h_geo_rem(i)) then h_heated = h_geo_rem(i) @@ -294,6 +330,12 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) ! endif endif endif + + ! Calculate heat tendency due to addition and transfer of internal heat + if (CS%id_internal_heat_heat_tendency > 0) then + work_3d(i,j,k) = ((GV%H_to_kg_m2 * tv%C_p) * Idt) * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * T_old(i,j,k)) + endif + endif ; enddo if (num_left <= 0) exit enddo ! k-loop @@ -304,6 +346,23 @@ subroutine geothermal(h, tv, dt, ea, eb, G, GV, CS, halo) enddo ; endif enddo ! j-loop + ! Post diagnostic of 3D tendencies (heat, temperature, and thickness) due to internal heat + if (CS%id_internal_heat_heat_tendency > 0) then + call post_data(CS%id_internal_heat_heat_tendency, work_3d, CS%diag, alt_h=h_old) + endif + if (CS%id_internal_heat_temp_tendency > 0) then + do j=js,je; do i=is,ie; do k=nz,1,-1 + work_3d(i,j,k) = Idt * (tv%T(i,j,k) - T_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_internal_heat_temp_tendency, work_3d, CS%diag, alt_h=h_old) + endif + if (CS%id_internal_heat_h_tendency > 0) then + do j=js,je; do i=is,ie; do k=nz,1,-1 + work_3d(i,j,k) = Idt * (h(i,j,k) - h_old(i,j,k)) + enddo; enddo; enddo + call post_data(CS%id_internal_heat_h_tendency, work_3d, CS%diag, alt_h=h_old) + endif + ! do i=is,ie ; do j=js,je ! resid(i,j) = tv%internal_heat(i,j) - resid(i,j) - GV%H_to_kg_m2 * & ! (G%mask2dT(i,j) * (CS%geo_heat(i,j) * (dt*Irho_cp))) @@ -392,6 +451,20 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) + ! Diagnostic for tendencies due to internal heat (in 3d) + CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & + 'internal_heat_heat_tendency', diag%axesTL, Time, & + 'Heat tendency (in 3D) due to internal (geothermal) sources', & + 'W m-2', v_extensive=.true.) + CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & + 'internal_heat_temp_tendency', diag%axesTL, Time, & + 'Temperature tendency (in 3D) due to internal (geothermal) sources', & + 'degC s-1', v_extensive=.true.) + CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & + 'internal_heat_h_tendency', diag%axesTL, Time, & + 'Thickness tendency (in 3D) due to internal (geothermal) sources', & + 'm OR kg m-2', v_extensive=.true.) + end subroutine geothermal_init !> Clean up and deallocate memory associated with the geothermal heating module. diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2ffdbcb775..79c1b744f0 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -3,21 +3,22 @@ module MOM_int_tide_input ! 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 : diag_ctrl, time_type -use MOM_diag_mediator, only : safe_alloc_ptr, post_data, register_diag_field -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_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_io, only : slasher, vardesc, MOM_read_data -use MOM_thickness_diffuse, only : vert_fill_TS -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, 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 : diag_ctrl, query_averaging_enabled +use MOM_diag_mediator, only : safe_alloc_ptr, post_data, register_diag_field +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_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : slasher, vardesc, MOM_read_data +use MOM_isopycnal_slopes, only : vert_fill_TS +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 +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs implicit none ; private @@ -37,11 +38,22 @@ module MOM_int_tide_input !! regulate the timing of diagnostic output. real :: TKE_itide_max !< Maximum Internal tide conversion !! available to mix above the BBL [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]. real, allocatable, dimension(:,:) :: TKE_itidal_coef !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. character(len=200) :: inputdir !< The directory for input files. + logical :: int_tide_source_test !< If true, apply an arbitrary generation site + !! for internal tide testing (BDM) + type(time_type) :: time_max_source !< A time for use in testing internal tides + real :: int_tide_source_x !< X Location of generation site + !! for internal tide for testing (BDM) + real :: int_tide_source_y !< Y Location of generation site + !! for internal tide for testing (BDM) + + !>@{ Diagnostic IDs integer :: id_TKE_itidal = -1, id_Nb = -1, id_N2_bot = -1 !!@} @@ -63,8 +75,8 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, 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 type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [m s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to the !! thermodynamic fields @@ -75,18 +87,20 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) 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 [s-2]. + N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in ! the massless layers filled vertically by diffusion. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. + logical :: avg_enabled ! for testing internal tides (BDM) + type(time_type) :: time_end !< For use in testing internal tides (BDM) + + integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed - real :: kappa_fill ! diffusivity used to fill massless layers - real :: dt_fill ! timestep used to fill massless layers is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -94,32 +108,43 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. - dt_fill = 7200. !### Dimensionalconstant [s]. - use_EOS = associated(tv%eqn_of_state) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, kappa_fill, dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt*US%s_to_T, T_f, S_f, G, GV, larger_h_denom=.true.) endif call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) -!$OMP parallel do default(none) shared(is,ie,js,je,G,itide,N2_bot,CS) + !$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) + itide%Nb(i,j) = G%mask2dT(i,j) * US%s_to_T*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 (CS%int_tide_source_test) then + itide%TKE_itidal_input(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag, time_end=time_end) + if (time_end <= CS%time_max_source) then + 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 + endif + enddo ; enddo + endif + endif + if (CS%debug) then - call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0) + 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) endif if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, itide%TKE_itidal_input, CS%diag) 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) + if (CS%id_N2_bot > 0 ) call post_data(CS%id_N2_bot, N2_bot, CS%diag) end subroutine set_int_tide_input @@ -156,11 +181,11 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density [Z m3 s-2 kg-1 ~> m4 s-2 kg-1]. + ! density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -259,11 +284,15 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) character(len=200) :: filename, tideamp_file, h2_file real :: mask_itidal + real :: max_frac_rough ! The fraction relating the maximum topographic roughness + ! to the mean depth [nondim] real :: utide ! constant tidal amplitude [m s-1] to be used if ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion [Z ~> m]. + 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 if (associated(CS)) then @@ -295,6 +324,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total "//& "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) + 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.", & + default=1.0e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -339,15 +372,35 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & + "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& + "or a negative value for no limitations on roughness.", & + units="nondim", default=0.1) + + ! The following parameters are used in testing the internal tide code. + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + "If true, apply an arbitrary generation site for internal tide testing", & + default=.false.) + if (CS%int_tide_source_test)then + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + "X Location of generation site for internal tide", default=1.) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + "Y Location of generation site for internal tide", default=1.) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", tlen_days, & + "Time interval from start of experiment for adding wave source", & + units="days", default=0) + CS%time_max_source = Time + set_time(0, days=tlen_days) + endif + do j=js,je ; do i=is,ie mask_itidal = 1.0 if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) - ! Restrict rms topo to 10 percent of column depth. - !### Note the use here of a hard-coded nondimensional constant. - itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(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))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& @@ -362,7 +415,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) 'Bottom Buoyancy Frequency', 's-1') CS%id_N2_bot = register_diag_field('ocean_model','N2_b_itide',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') + 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) end subroutine int_tide_input_init diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index b5caeb2f53..f5343f86e2 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -55,8 +55,8 @@ module MOM_kappa_shear real :: lambda2_N_S !< The square of the ratio of the coefficients of !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. - real :: TKE_bg !< The background level of TKE [m2 s-2]. - real :: kappa_0 !< The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + 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_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -73,7 +73,7 @@ module MOM_kappa_shear !! massive layers in this calculation. ! I can think of no good reason why this should be false. - RWH real :: vel_underflow !< Velocity components smaller than vel_underflow - !! are set to 0 [m s-1]. + !! are set to 0 [Z T-1 ~> m s-1]. ! logical :: layer_stagger = .false. ! If true, do the calculations centered at ! layers, rather than the interfaces. logical :: debug = .false. !< If true, write verbose debugging messages. @@ -98,9 +98,9 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & 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) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial 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 !< A structure containing pointers to any @@ -109,21 +109,18 @@ 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 [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 s-1 ~> m2 s-1]. Initially this is the + !! (not layer!) [Z2 T-1 ~> m2 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(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) [m2 s-2]. - !! Initially this is the value from the previous - !! timestep, which may accelerate the iteration - !! toward convergence. + 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 s-1 ~> m2 s-1]. This discards any + !! (not layer!) [Z2 T-1 ~> m2 s-1]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -131,27 +128,25 @@ 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 m. - u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. + h_2d, & ! A 2-D version of h, but converted to [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, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & - kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. + kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1]. + tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. - u0xdz, & ! The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. - v0xdz, & ! The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. + 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 [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. - kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE [m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [s-2]. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. + 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]. + 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 [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -172,27 +167,11 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Diagnostics that should be deleted? #ifdef ADD_DIAGNOSTICS real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d + I_Ld2_1d, dz_Int_1d real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. I_Ld2_2d, dz_Int_2d real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. I_Ld2_3d, dz_Int_3d -#endif -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkap, dtke_norm, & - ksrc_av ! The average through the iterations of k_src [s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 #endif is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -289,22 +268,29 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = 0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + 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) - ! ---------------------------------------------------- + ! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d + ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif +#ifdef ADD_DIAGNOSTICS + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) +#endif ! call cpu_clock_begin(id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. @@ -328,15 +314,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo endif #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1) - do K=2,nzc - I_Ld2_2d(i,K) = I_L2_bdry(K) + & - (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) - dz_Int_2d(i,K) = dz_Int(K) - enddo - I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1) - do K=nzc+2,nz+1 - I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 + do K=1,nz+1 + I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) enddo #endif ! call cpu_clock_end(id_clock_setup) @@ -344,8 +323,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 kappa_2d(i,K) = 0.0 ; tke_2d(i,K) = 0.0 #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,K) = 0.0 - dz_Int_2d(i,K) = dz_Int(K) + I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 #endif enddo endif ; enddo ! i-loop @@ -355,16 +333,15 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS - I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) - dz_Int_3d(i,j,K) = dz_Int_2d(i,K) + I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) ; dz_Int_3d(i,j,K) = dz_Int_2d(i,K) #endif enddo ; enddo enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) - call hchksum(tke_io, "tke", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag) @@ -384,9 +361,9 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ 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(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_in !< Initial zonal velocity [m s-1]. (Intent in) + intent(in) :: u_in !< Initial zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v_in !< Initial meridional velocity [m s-1]. + intent(in) :: v_in !< Initial 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(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -400,19 +377,16 @@ 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 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) [m2 s-2]. - !! Initially this is the value from the previous - !! timestep, which may accelerate the iteration - !! toward convergence. + 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 s-1 ~> m2 s-1]. + intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -420,29 +394,26 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Local variables real, dimension(SZIB_(G),SZK_(GV)) :: & - h_2d, & ! A 2-D version of h, but converted to m. - u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. + h_2d, & ! A 2-D version of h, but converted to [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, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io [Z2 s-1 ~> m2 s-1]. + kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & - tke_2d ! 2-D version tke_io [m2 s-2]. + tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. - u0xdz, & ! The initial zonal velocity times dz [m Z s-1 ~> m2 s-1]. - v0xdz, & ! The initial meridional velocity times dz [m Z s-1 ~> m2 s-1]. + 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 [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. - kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE [m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [s-2]. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. + 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]. + 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 [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -466,34 +437,18 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Diagnostics that should be deleted? #ifdef ADD_DIAGNOSTICS real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d + I_Ld2_1d, dz_Int_1d real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. I_Ld2_2d, dz_Int_2d real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. I_Ld2_3d, dz_Int_3d -#endif -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & - ksrc_av ! The average through the iterations of k_src [s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 #endif isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all - k0dt = dt*CS%kappa_0 + k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -612,25 +567,29 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 - surface_pres = 0.0 ; if (associated(p_surf)) then + f2 = G%CoriolisBu(I,J)**2 + surface_pres = 0.0 ; if (associated(p_surf)) & surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & (p_surf(i+1,j) + p_surf(i,j+1))) - endif ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif +#ifdef ADD_DIAGNOSTICS + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) - +#endif ! call cpu_clock_begin(Id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then @@ -645,23 +604,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ kappa_2d(I,K,J2) = kappa_avg(kc(K)) tke_2d(I,K) = tke_avg(kc(K)) else - kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + & - kf(K) * kappa_avg(kc(K)+1) - tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & - kf(K) * tke_avg(kc(K)+1) + kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + kf(K) * kappa_avg(kc(K)+1) + tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + kf(K) * tke_avg(kc(K)+1) endif enddo endif #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1) - do K=2,nzc - I_Ld2_2d(I,K) = I_L2_bdry(K) + & - (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) - dz_Int_2d(I,K) = dz_Int(K) - enddo - I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1) - do K=nzc+2,nz+1 - I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 + do K=1,nz+1 + I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) enddo #endif ! call cpu_clock_end(Id_clock_setup) @@ -669,8 +619,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 kappa_2d(I,K,J2) = 0.0 ; tke_2d(I,K) = 0.0 #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,K) = 0.0 - dz_Int_2d(I,K) = dz_Int(K) + I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 #endif enddo endif ; enddo ! i-loop @@ -679,8 +628,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS - I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) - dz_Int_3d(I,J,K) = dz_Int_2d(I,K) + I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) ; dz_Int_3d(I,J,K) = dz_Int_2d(I,K) #endif enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec @@ -693,7 +641,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%Z_to_m**2) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) call Bchksum(tke_io, "tke", G%HI) endif @@ -710,100 +658,107 @@ 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, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US) + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) 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)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at - !! an interface [m2 s-2]. + intent(out) :: tke !< The Turbulent Kinetic Energy per unit mass at + !! an interface [Z2 T-2 ~> m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. - real, intent(in) :: f2 !< The square of the Coriolis parameter [s-2]. + real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2]. real, intent(in) :: surface_pres !< The surface pressure [Pa]. real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. real, dimension(SZK_(GV)), & - intent(in) :: u0xdz !< The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. + intent(in) :: u0xdz !< The initial zonal velocity times dz [Z L T-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & - intent(in) :: v0xdz !< The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. + intent(in) :: v0xdz !< The initial meridional velocity times dz [Z L T-1 ~> m2 s-1]. real, dimension(SZK_(GV)), & intent(in) :: T0xdz !< The initial temperature times dz [degC Z ~> degC m]. real, dimension(SZK_(GV)), & intent(in) :: S0xdz !< The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. - real, intent(in) :: dt !< Time increment [s]. + intent(out) :: tke_avg !< The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. + real, dimension(SZK_(GV)+1), & + optional, intent(out) :: I_Ld2_1d !< The inverse of the squared mixing length [Z-2 ~> m-2]. + real, dimension(SZK_(GV)+1), & + optional, intent(out) :: dz_Int_1d !< The extent of a finite-volume space surrounding an interface, + !! as used in calculating kappa and TKE [Z ~> m]. real, dimension(nzc) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. + u, & ! The zonal velocity after a timestep of mixing [L T-1 ~> m s-1]. + v, & ! The meridional velocity after a timestep of mixing [L T-1 ~> m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. T, & ! The potential temperature after a timestep of mixing [degC]. Sal, & ! The salinity after a timestep of mixing [ppt]. - u_test, v_test, T_test, S_test + u_test, v_test, & ! Temporary velocities [L T-1 ~> m s-1]. + T_test, S_test ! Temporary temperatures [degC] and salinities [ppt]. real, dimension(nzc+1) :: & - N2, & ! The squared buoyancy frequency at an interface [s-2]. + 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]. 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. - S2, & ! The squared shear at an interface [s-2]. + 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 s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. - k_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. - kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 s-1 ~> m2 s-1]. - tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. - kappa_pred, & ! The value of kappa from a predictor step [Z2 s-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 [Z2 T-1 ~> m2 s-1]. + kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 T-1 ~> m2 s-1]. + 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]. pressure, & ! The pressure at an interface [Pa]. T_int, & ! The temperature interpolated to an interface [degC]. Sal_int, & ! The salinity interpolated to an interface [ppt]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 ppt-1 ~> m s-2 ppt-1]. + dbuoy_dS, & ! and salinity, [Z T-2 degC-1 ~> m s-2 degC-1] and [Z T-2 ppt-1 ~> m s-2 ppt-1]. 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 [Z2 m-2 s ~> s]. - K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s ~> s]. + K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. local_src_avg, & ! The time-integral of the local source [nondim]. - tol_min, & ! Minimum tolerated ksrc for the corrector step [s-1]. - tol_max, & ! Maximum tolerated ksrc for the corrector step [s-1]. - tol_chg, & ! The tolerated change integrated in time [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 change integrated in time [s T-nondim]. dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and - ! sources from the elliptic term [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. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. - real :: gR0 ! Rho_0 times g [kg m-2 s-2]. - real :: g_R0 ! g_R0 is g/Rho [Z m3 kg-1 s-2 ~> m4 kg-1 s-2]. + real :: gR0 ! A conversion factor from Z to Pa equal to Rho_0 times g + ! [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z m3 kg-1 T-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: dt_rem ! The remaining time to advance the solution [s]. - real :: dt_now ! The time step used in the current iteration [s]. + real :: dt_rem ! The remaining time to advance the solution [T ~> s]. + real :: dt_now ! The time step used in the current iteration [T ~> s]. real :: dt_wt ! The fractional weight of the current iteration [nondim]. real :: dt_test ! A time-step that is being tested for whether it - ! gives acceptably small changes in k_src [s]. - real :: Idtt ! Idtt = 1 / dt_test [s-1]. - real :: dt_inc ! An increment to dt_test that is being tested [s]. + ! 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]. logical :: valid_dt ! If true, all levels so far exhibit acceptably small @@ -818,9 +773,27 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! to estimate the maximum permitted time step. I.e., ! the resolution is 1/2^dt_refinements. integer :: k, itt, itt_dt +#ifdef DEBUG + integer :: max_debug_itt ; parameter(max_debug_itt=20) + real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt + real, dimension(SZK_(GV)+1) :: & + Ri_k, tke_prev, dtke, dkappa, dtke_norm, & + N2_debug, & ! A version of N2 for debugging [T-2 ~> s-2] + ksrc_av ! The average through the iterations of k_src [T-1 ~> s-1]. + real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & + tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 + real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & + dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm + real, dimension(SZK_(GV),0:max_debug_itt) :: & + u_it1, v_it1, rho_it1, T_it1, S_it1 + real, dimension(0:max_debug_itt) :: & + dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag + real, dimension(max_debug_itt) :: dt_it1 +#endif Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*(GV%g_Earth*US%m_to_Z) ; g_R0 = (GV%g_Earth*US%m_to_Z**2)/GV%Rho0 + gR0 = GV%z_to_H*GV%H_to_Pa + g_R0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -895,10 +868,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo dz_Int(nzc) = dz_Int(nzc) + dz(nzc) ; dz_Int(nzc+1) = 0.0 -#ifdef ADD_DIAGNOSTICS - do K=1,nzc+1 ; I_Ld2_1d(K) = 0.0 ; enddo -#endif - dist_from_bot = 0.0 do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz(k) @@ -910,26 +879,26 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*US%Z_to_m*dz(k-1) + pressure(K) = pressure(K-1) + gR0*dz(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, 2, nzc-1, tv%eqn_of_state) do K=2,nzc - dbuoy_dT(K) = -G_R0*dbuoy_dT(K) - dbuoy_dS(K) = -G_R0*dbuoy_dS(K) + dbuoy_dT(K) = -g_R0*dbuoy_dT(K) + dbuoy_dS(K) = -g_R0*dbuoy_dS(K) enddo else - do K=1,nzc+1 ; dbuoy_dT(K) = -G_R0 ; dbuoy_dS(K) = 0.0 ; enddo + do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif #ifdef DEBUG - N2(1) = 0.0 ; N2(nzc+1) = 0.0 + N2_debug(1) = 0.0 ; N2_debug(nzc+1) = 0.0 do K=2,nzc - N2(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & - dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & - I_dz_int(K), 0.0) + N2_debug(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & + dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & + I_dz_int(K), 0.0) enddo do k=1,nzc u_it1(k,0) = u0xdz(k)*Idz(k) ; v_it1(k,0) = v0xdz(k)*Idz(k) @@ -937,10 +906,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo do K=1,nzc+1 kprev_it1(K,0) = kappa(K) ; kappa_it1(K,0) = kappa(K) - tke_it1(K,0) = tke(K) - N2_it1(K,0) = N2(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = k_src(K) + tke_it1(K,0) = 0.0 + N2_it1(K,0) = N2_debug(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = K_src(K) enddo - do k=nzc+1,nz + do k=nzc+1,GV%ke u_it1(k,0) = 0.0 ; v_it1(k,0) = 0.0 T_it1(k,0) = 0.0 ; S_it1(k,0) = 0.0 kprev_it1(K+1,0) = 0.0 ; kappa_it1(K+1,0) = 0.0 ; tke_it1(K+1,0) = 0.0 @@ -948,12 +917,12 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo do itt=1,max_debug_itt dt_it1(itt) = 0.0 - do k=1,nz + do k=1,GV%ke u_it1(k,itt) = 0.0 ; v_it1(k,itt) = 0.0 T_it1(k,itt) = 0.0 ; S_it1(k,itt) = 0.0 rho_it1(k,itt) = 0.0 enddo - do K=1,nz+1 + do K=1,GV%ke+1 kprev_it1(K,itt) = 0.0 ; kappa_it1(K,itt) = 0.0 ; tke_it1(K,itt) = 0.0 N2_it1(K,itt) = 0.0 ; Sh2_it1(K,itt) = 0.0 ksrc_it1(K,itt) = 0.0 @@ -961,7 +930,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & K_Q_it1(K,itt) = 0.0 ; d_dkappa_it1(K,itt) = 0.0 enddo enddo - do K=1,nz+1 ; ksrc_av(K) = 0.0 ; enddo + do K=1,GV%ke+1 ; ksrc_av(K) = 0.0 ; enddo #endif ! This call just calculates N2 and S2. @@ -992,7 +961,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #ifdef DEBUG do K=1,nzc+1 Ri_k(K) = 1e3 ; if (S2(K) > 1e-3*N2(K)) Ri_k(K) = N2(K) / S2(K) - tke_prev(K) = tke(K) + if (itt > 1) then ; tke_prev(K) = tke(K) ; else ; tke_prev(K) = 0.0 ; endif enddo #endif @@ -1043,10 +1012,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) - if ((k_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & - (k_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then + if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & + (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit endif else @@ -1069,11 +1038,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & - ((Ri_crit*S2(K) - N2(K)) / & - (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) - if ((k_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & - (k_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) + if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & + (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit endif else @@ -1090,7 +1058,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dt_inc = 0.0 endif - dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc,dt_rem) + dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc, dt_rem) do K=2,nzc local_src_avg(K) = local_src_avg(K) + dt_now * local_src(K) enddo @@ -1173,7 +1141,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_mag(itt) = 0.0 wt_itt = 1.0/real(itt) ; wt_tot = 0.0 do K=1,nzc+1 - ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*k_src(K) + ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*K_src(K) wt_tot = wt_tot + dz_Int(K) * ksrc_av(K) enddo ! Use the 1/0=0 convention. @@ -1184,7 +1152,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_mag(itt) = k_mag(itt) + wt(K)*kappa_mid(K) dkappa_it1(K,itt) = kappa_pred(K) - kappa_out(K) dk_wt_it1(itt) = dk_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) - if (dk > 0.0) then + if (dkappa_it1(K,itt) > 0.0) then dkpos_wt_it1(itt) = dkpos_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) else dkneg_wt_it1(itt) = dkneg_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) @@ -1196,7 +1164,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) dtke(K) = tke_pred(K) - tke(K) dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkap(K) = kappa_pred(K) - kappa_out(K) + dkappa(K) = kappa_pred(K) - kappa_out(K) enddo if (itt <= max_debug_itt) then do k=1,nzc @@ -1204,8 +1172,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & T_it1(k,itt) = T(k) ; S_it1(k,itt) = Sal(k) enddo do K=1,nzc+1 - kprev_it1(K,itt)=kappa_out(K) - kappa_it1(K,itt)=kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) + kprev_it1(K,itt) = kappa_out(K) + kappa_it1(K,itt) = kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) N2_it1(K,itt)=N2(K) ; Sh2_it1(K,itt)=S2(K) ksrc_it1(K,itt) = kappa_src(K) K_Q_it1(K,itt) = kappa_out(K) / (TKE(K)) @@ -1213,7 +1181,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m_to_Z**2*1e-100) + dkappa_norm(K,itt) = dkappa(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m2_s_to_Z2_T*1e-100) enddo endif #endif @@ -1222,6 +1190,19 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo ! end itt loop +#ifdef ADD_DIAGNOSTICS + if (present(I_Ld2_1d)) then + do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo + do K=2,nzc ; if (TKE(K) > 0.0) & + I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) / TKE(K) + enddo + endif + if (present(dz_Int_1d)) then + do K=1,nzc+1 ; dz_Int_1d(K) = dz_Int(K) ; enddo + do K=nzc+2,GV%ke ; dz_Int_1d(K) = 0.0 ; enddo + endif +#endif + end subroutine kappa_shear_column !> This subroutine calculates the velocities, temperature and salinity that @@ -1233,7 +1214,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & 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 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [m s-1]. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [m s-1]. real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. @@ -1242,10 +1223,10 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature [Z s-2 degC-1 ~> m s-2 degC-1]. + !! temperature [Z T-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity [Z s-2 ppt-1 ~> m s-2 ppt-1]. - real, intent(in) :: dt !< The time step [s]. + !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. + real, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. @@ -1253,9 +1234,9 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & 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(nz+1), optional, & - intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. + intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. real, dimension(nz+1), optional, & - intent(inout) :: S2 !< The squared shear at interfaces [s-2]. + intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. @@ -1266,7 +1247,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared [Z2 m-2 ~> 1]. + ! units squared [Z2 s2 T-2 m-2 ~> 1]. real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1337,7 +1318,8 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then - L2_to_Z2 = US%m_to_Z**2 + ! L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 + L2_to_Z2 = US%L_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) @@ -1368,57 +1350,58 @@ end subroutine calculate_projected_state subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_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 [s-2]. - real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [s-2]. + 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 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to - !! boundaries [m-2]. + !! boundaries [Z-2 !> m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. - real, intent(in) :: f2 !< The squared Coriolis parameter [s-2]. + 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. 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(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at - !! interfaces [s]. + !! interfaces [Z2 m-2 s2 T-1 ~> s]. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at - !! interfaces [m2 s-2]. + !! interfaces [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), optional, & - intent(out) :: kappa_src !< The source term for kappa [s-1]. + intent(out) :: kappa_src !< The source term for kappa [T-1]. real, dimension(nz+1), optional, & intent(out) :: local_src !< The sum of all local sources for kappa, - !! [s-1]. + !! [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 [m s-1]. - dQdz ! Half the partial derivative of TKE with depth [m s-2]. + aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [Z T-1 ~> m 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 s-1 ~> m2 s-1]. - dQ, & ! The change in TKE [m2 s-2]. + dK, & ! The change in kappa [Z2 T-1 ~> m2 s-1]. + 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]. - TKE_decay, & ! The local TKE decay rate [s-1]. - k_src, & ! The source term in the kappa equation [s-1]. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 s Z-2 ~> s]. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 s-1 ~> s-1]. + I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [Z-2 ~> m-2]. + 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]. 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. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear - ! and stratification [m2 s-3]. (For convenience, + ! and stratification [Z2 T-3 ~> m2 s-3]. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. - real :: bd1 ! A term in the denominator of bQ or bK. + real :: bQ ! The inverse of the pivot in the tridiagonal equations [T Z-1 ~> s m-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 :: bKd1 ! A term in the denominator of bK [Z ~> m]. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to ! shear (i.e. proportional to |S|*tke), nondimensional. @@ -1426,30 +1409,28 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! stratification (i.e. proportional to N*tke) [nondim]. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: q0 ! The background level of TKE [m2 s-2]. - real :: Ilambda2 ! 1.0 / CS%lambda**2. + real :: q0 ! The background level of TKE [Z2 T-2 ~> m2 s-2]. + real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be - ! solved for [m2 s-2]. - real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: max_err ! The maximum value of norm_err in a column [nondim]. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 s-1 ~> m2 s-1]. + ! 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 :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. - real :: diffusive_src ! The diffusive source in the kappa equation [m s-1]. + real :: diffusive_src ! The diffusive source in the kappa equation [Z T-1 ~> m 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 [s-1]. + ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]. - real :: kappa_mean ! A mean value of kappa [Z2 s-1 ~> m2 s-1]. + real :: kappa_mean ! A mean value of kappa [Z2 T-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. real :: decay_term_k ! The decay term in the diffusivity equation - real :: decay_term_Q ! The decay term in the TKE equation + real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1] real :: I_Q ! The inverse of TKE [s2 m-2] real :: kap_src - real :: v1, v2 - real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length - ! units squared [m2 Z-2]. + real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] + real :: v2 real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1472,24 +1453,22 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: itt, k, k2 #ifdef DEBUG integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: K_err_lin, Q_err_lin + real :: K_err_lin, Q_err_lin, TKE_src_norm real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 s-1 ~> m2 s-1]. - TKE_prev ! The value of TKE at the start of the current iteration [m2 s-2]. + 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]. + TKE_prev ! The value of TKE at the start of the current iteration [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 - real :: norm_err ! The absolute change in kappa between iterations, - ! normalized by the value of kappa [nondim]. - real :: max_TKE_err, min_TKE_err, TKE_err(nz) ! Various normalized TKE changes. integer :: it2 #endif c_N2 = CS%C_N**2 ; c_S2 = CS%C_S**2 - q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) + q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 + TKE_min = max(CS%TKE_bg, 1.0E-20*US%m_to_Z**2*US%T_to_s**2) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 - Z2_to_L2 = US%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1503,7 +1482,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Ri = N2(K) / S2(K) ! k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ! ((Ri_crit - Ri) / (Ri_crit + CS%FRi_curvature*Ri)) - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) ke_src = K if (ks_src > k) ks_src = K @@ -1573,34 +1552,34 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces [Z s-1 ~> m s-1]. + ! aQ is the coupling between adjacent interfaces [Z T-1 ~> m s-1]. do k=1,min(ke_tke,nz) aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 - bd1 = dz_Int(1) * TKE_decay(1) - bQ = 1.0 / (bd1 + aQ(1)) + tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + bQd1 = dz_Int(1) * TKE_decay(1) + bQ = 1.0 / (bQd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) - cQ(2) = aQ(1) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ + 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 = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) - bQ = 1.0 / (bd1 + aQ(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) + bQ = 1.0 / (bQd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) - cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ + cQ(K+1) = aQ(k) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ enddo if ((ke_tke == nz+1) .and. .not.(tke_noflux_bottom_BC)) then tke(nz+1) = TKE_min dQ(nz+1) = 0.0 else k = ke_tke - tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = 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)) @@ -1612,8 +1591,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! 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)) + & - cQ(K+1)*(tke(K+1) - e1(K+1)*tke(K))) / & - (1.0 - cQ(K+1)*e1(K+1)), TKE_min) + 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) ! Adjust TKE deeper in the water column in case ke_tke increases. @@ -1643,17 +1621,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) * Z2_to_L2 / tke(K) + I_L2_bdry(K) + I_Ld2(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) * Z2_to_L2 / tke(K) + I_L2_bdry(K) - bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) - bK = 1.0 / (bd1 + Idz(k)) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + bKd1 = dz_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)) - cK(K+1) = Idz(k) * bK ; cKcomp = bd1 * bK ! = 1 - cK(K+1) + kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_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. if (kappa(K) < cKcomp*kappa_trunc) then @@ -1692,7 +1670,7 @@ 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) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (kappa0*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)) @@ -1705,9 +1683,9 @@ 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) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) - kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + & + kap_src = dz_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. @@ -1718,8 +1696,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cK(K+1) = bK * Idz(k) cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) + !### The following expression appears to be dimensionally inconsistent in length. -RWH dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + US%m_to_Z*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + ! I think that the second term needs to be multiplied by dz_Int(K): + ! dz_Int(K)*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1733,12 +1714,12 @@ 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) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - & + tke_src = dz_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)) + & - ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K))) + ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K))) ! Ensure that the pivot is always positive, and that 0 <= cQ <= 1. ! Otherwise do not use Newton's method. @@ -1765,7 +1746,7 @@ 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) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (kappa0*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) @@ -1775,8 +1756,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & else bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), & - -0.5*TKE(K)) + dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) endif else @@ -1791,9 +1771,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K < nz+1) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(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))) + tke_src_norm = (dz_Int(K) * (kappa0*S2(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))) endif #endif dK(K) = 0.0 @@ -1810,8 +1790,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (.not. abort_Newton) then do K=ke_kappa,2,-1 ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * dK(K+1)), & - -0.5*TKE(K)) + dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * dK(K+1)), -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) dK(K) = dK(K) + (cK(K+1)*dK(K+1) + dKdQ(K) * dQ(K)) ! Truncate away negligibly small values of kappa. @@ -1843,52 +1822,31 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! 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(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) - kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + & + kap_src = dz_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))) + !### The last line of the following appears to be dimensionally inconsistent with the first two. + ! I think that the term on the last line needs to be multiplied by dz_Int(K). K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & - dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & - US%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - - tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & - Z2_to_L2*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))) - Q_err_lin = (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)) + & - dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src + dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - & + US%m_to_Z*(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))) + 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)) + & + dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) enddo #endif endif ! End of the Newton's method solver. ! Test kappa for convergence... -#ifdef DEBUG - max_err = 0.0 ; max_TKE_err = 0.0 ; min_TKE_err = 0.0 - do K=min(ks_kappa,ks_kappa_prev),max(ke_kappa,ke_kappa_prev) - norm_err = abs(kappa(K) - kappa_prev(K)) / & - (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) - if (max_err < norm_err) max_err = norm_err - - TKE_err(K) = dQ(K) / (tke(K) - 0.5*dQ(K)) - if (TKE_err(K) > max_TKE_err) max_TKE_err = TKE_err(K) - if (TKE_err(K) < min_TKE_err) min_TKE_err = TKE_err(K) - enddo - if (do_Newton) then - if (max(max_err,max_TKE_err,-min_TKE_err) >= 2.0*Newton_err) then - do_Newton = .false. ; abort_Newton = .true. - endif - else - if (max(max_err,max_TKE_err,-min_TKE_err) < Newton_err) do_Newton = .true. - endif - within_tolerance = (max_err < tol_err) -#else - ! max_err = 0.0 if ((tol_err < Newton_err) .and. (.not.abort_Newton)) then - ! A lower tolerance is used to switch to Newton's method than to - ! switch back. + ! A lower tolerance is used to switch to Newton's method than to switch back. Newton_test = Newton_err ; if (do_Newton) Newton_test = 2.0*Newton_err was_Newton = do_Newton within_tolerance = .true. ; do_Newton = .true. @@ -1914,7 +1872,6 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif enddo endif -#endif if (abort_Newton) then do_Newton = .false. ; abort_Newton = .false. @@ -1927,14 +1884,14 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & #ifdef DEBUG if (itt <= max_debug_itt) then do K=1,nz+1 - kprev_it1(K,itt)=kappa_prev(K) - kappa_it1(K,itt)=kappa(K) ; tke_it1(K,itt) = tke(K) + kprev_it1(K,itt) = kappa_prev(K) + kappa_it1(K,itt) = kappa(K) ; tke_it1(K,itt) = tke(K) dkappa_it1(K,itt) = kappa(K) - kappa_prev(K) dkappa_norm_it1(K,itt) = (kappa(K) - kappa_prev(K)) / & (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) K_Q_it1(K,itt) = kappa(K) / max(TKE(K),TKE_min) d_dkappa_it1(K,itt) = 0.0 - if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20) & + if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20*US%m2_s_to_Z2_T) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif enddo @@ -1964,16 +1921,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & 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)) if (diffusive_src <= 0.0) then - local_src(K) = k_src(K) + chg_by_k0 + 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 / dz_Int(K) endif enddo endif if (present(kappa_src)) then kappa_src(1) = 0.0 ; kappa_src(nz+1) = 0.0 do K=2,nz - kappa_src(K) = k_src(K) + kappa_src(K) = K_src(K) enddo endif @@ -2043,7 +2000,7 @@ 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. Defaults to value of KD.", & - units="m2 s-1", default=KD_normal, scale=US%m_to_Z**2) + units="m2 s-1", default=KD_normal, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the "//& "Richardson number in the kappa source term in the "//& @@ -2079,7 +2036,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "TKE_BACKGROUND", CS%TKE_bg, & "A background level of TKE used in the first iteration "//& "of the kappa equation. TKE_BACKGROUND could be 0.", & - units="m2 s-2", default=0.0) + units="m2 s-2", default=0.0, scale=US%m_to_Z**2*US%T_to_s**2) call get_param(param_file, mdl, "KAPPA_SHEAR_ELIM_MASSLESS", CS%eliminate_massless, & "If true, massless layers are merged with neighboring "//& "massive layers in this calculation. The default is "//& @@ -2097,7 +2054,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "DEBUG_KAPPA_SHEAR", CS%debug, & "If true, write debugging data for the kappa-shear code. \n"//& "Caution: this option is _very_ verbose and should only "//& @@ -2123,9 +2080,9 @@ 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%Z_to_m**2) + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_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') + 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2) #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & 'Inverse kappa decay scale at interfaces', 'm-2', conversion=US%m_to_Z**2) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 75aa447e15..5e42de0fea 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -6,27 +6,50 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase -use MOM_forcing_type, only : forcing, optics_type -use MOM_grid, only : ocean_grid_type -use MOM_io, only : slasher -use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use time_interp_external_mod, only : init_external_field, time_interp_external -use time_interp_external_mod, only : time_interp_external_init +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 #include public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel +public extract_optics_slice, extract_optics_fields, optics_nbands +public absorbRemainingSW, sumSWoverBands + +!> This type is used to store information about ocean optical properties +type, public :: optics_type + integer :: nbands !< The number of penetrating bands of SW radiation + + real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] + !! The number of radiation bands is most rapidly varying (first) index. + + real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface + !! in each of the nbands bands that penetrates beyond the surface. + !! The most rapidly varying dimension is the band. + + real, pointer, dimension(:) :: & + min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + + real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next + !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. + real :: PenSW_absorb_Invlen !< The inverse of the thickness that is used to absorb the remaining + !! shortwave heat flux when it drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]. + 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. + +end type optics_type !> The control structure with paramters for the MOM_opacity module type, public :: opacity_CS ; private - logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified below) to - !! determine the e-folding depth of incoming short wave radiation. - !! The default is false. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified by OPACITY_SCHEME) to + !! determine the e-folding depth of incoming shortwave radiation. integer :: opacity_scheme !< An integer indicating which scheme should be used to translate !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. @@ -41,17 +64,11 @@ module MOM_opacity !! radiation that is in the blue band [nondim]. real :: opacity_land_value !< The value to use for opacity over land [m-1]. !! The default is 10 m-1 - a value for muddy water. - integer :: sbc_chl !< An integer handle used in time interpolation of - !! chlorophyll read from a file. - logical :: chl_from_file !< If true, chl_a is read from a file. - type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - !< A pointer to the control structure of the tracer modules. !>@{ Diagnostic IDs - integer :: id_sw_pen = -1, id_sw_vis_pen = -1, id_chl = -1 + integer :: id_sw_pen = -1, id_sw_vis_pen = -1 integer, pointer :: id_opacity(:) => NULL() !!@} end type opacity_CS @@ -65,42 +82,49 @@ module MOM_opacity character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme +real, parameter :: op_diag_len = 1e-10 !< Lengthscale L used to remap opacity + !! from op to 1/L * tanh(op * L) + contains !> This sets the opacity of sea water based based on one of several different schemes. -subroutine set_opacity(optics, fluxes, G, GV, CS) +subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] 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(opacity_CS), pointer :: CS !< The control structure earlier set up by !! opacity_init. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions[mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] -! local variables + ! Local variables integer :: i, j, k, n, is, ie, js, je, nz real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation. logical :: call_for_surface ! if horizontal slice is the surface layer - real :: tmp(SZI_(G),SZJ_(G),SZK_(G)) ! A 3-d temporary array. - real :: chl(SZI_(G),SZJ_(G),SZK_(G)) ! The concentration of chlorophyll-A [mg m-3]. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. + real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [W m-2]. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & "Module must be initialized via opacity_init before it is used.") - if (CS%var_pen_sw) then - if (CS%chl_from_file) then - call opacity_from_chl(optics, fluxes, G, CS) - else - call get_chl_from_model(chl, G, CS%tracer_flow_CSp) - call opacity_from_chl(optics, fluxes, G, CS, chl) - endif + if (present(chl_2d) .or. present(chl_3d)) then + ! The optical properties are based on cholophyll concentrations. + call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input if (optics%nbands <= 1) then ; Inv_nbands = 1.0 else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif @@ -115,7 +139,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo - if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then + if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 @@ -123,15 +147,15 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) - optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) + optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * sw_total(i,j) + optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * sw_total(i,j) enddo ; enddo endif else do k=1,nz ; do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%opacity_band(n,i,j,k) = inv_sw_pen_scale enddo ; enddo ; enddo ; enddo - if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then + if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 @@ -139,11 +163,12 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands - optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * fluxes%sw(i,j) + optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * sw_total(i,j) enddo ; enddo ; enddo endif endif endif + if (query_averaging_enabled(CS%diag)) then if (CS%id_sw_pen > 0) then !$OMP parallel do default(shared) @@ -178,7 +203,10 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie - tmp(i,j,k) = optics%opacity_band(n,i,j,k) + ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. + ! This gives a nearly identical value when op << 1/L but allows one to + ! store the values when opacity is divergent (i.e. opaque). + tmp(i,j,k) = tanh(op_diag_len * optics%opacity_band(n,i,j,k)) / op_diag_len enddo ; enddo ; enddo call post_data(CS%id_opacity(n), tmp, CS%diag) endif ; enddo @@ -189,17 +217,22 @@ end subroutine set_opacity !> This sets the "blue" band opacity based on chloophyll A concencentrations !! The red portion is lumped into the net heating at the surface. -subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) - type(optics_type), intent(inout) :: optics !< An optics structure that has values - !! set based on the opacities. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(opacity_CS), pointer :: CS !< The control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, - !! in mg m-3. +subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] + 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(opacity_CS), pointer :: CS !< The control structure. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating @@ -217,7 +250,7 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) integer :: i, j, k, n, is, ie, js, je, nz, nbands logical :: multiband_vis_input, multiband_nir_input - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! In this model, the Morel (modified) and Manizza (modified) schemes ! use the "blue" band in the parameterizations to determine the e-folding @@ -227,9 +260,8 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) ! Morel, A., Optical modeling of the upper ocean in relation to its biogenous ! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. ! - ! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical -! feedbacks amoung phytoplankton, upper ocean physics and sea-ice in a +! feedbacks among phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. nbands = optics%nbands @@ -240,61 +272,51 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) if (nbands <= 2) then ; Inv_nbands_nir = 0.0 else ; Inv_nbands_nir = 1.0 / real(nbands - 2.0) ; endif - multiband_vis_input = (associated(fluxes%sw_vis_dir) .and. & - associated(fluxes%sw_vis_dif)) - multiband_nir_input = (associated(fluxes%sw_nir_dir) .and. & - associated(fluxes%sw_nir_dif)) + multiband_vis_input = (associated(sw_vis_dir) .and. & + associated(sw_vis_dif)) + multiband_nir_input = (associated(sw_nir_dir) .and. & + associated(sw_nir_dif)) chl_data(:,:) = 0.0 - if (present(chl_in)) then - do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,1) ; enddo ; enddo + if (present(chl_3d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,1) ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (chl_in(i,j,k) < 0.0)) then - write(mesg,'(" Negative chl_in of ",(1pe12.4)," found at i,j,k = ", & - & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & - chl_in(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) - call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) + if ((G%mask2dT(i,j) > 0.5) .and. (chl_3d(i,j,k) < 0.0)) then + write(mesg,'(" Negative chl_3d of ",(1pe12.4)," found at i,j,k = ", & + & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & + chl_3d(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) + call MOM_error(FATAL, "MOM_opacity opacity_from_chl: "//trim(mesg)) endif enddo ; enddo ; enddo - else - ! Only the 2-d surface chlorophyll can be read in from a file. The - ! same value is assumed for all layers. - call time_interp_external(CS%sbc_chl, CS%Time, chl_data) + elseif (present(chl_2d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_2d(i,j) ; enddo ; enddo do j=js,je ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then - write(mesg,'(" Time_interp negative chl of ",(1pe12.4)," at i,j = ",& + if ((G%mask2dT(i,j) > 0.5) .and. (chl_2d(i,j) < 0.0)) then + write(mesg,'(" Negative chl_2d of ",(1pe12.4)," at i,j = ", & & 2(i3), "lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & chl_data(i,j), i, j, G%geoLonT(i,j), G%geoLatT(i,j) - call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) + call MOM_error(FATAL, "MOM_opacity opacity_from_chl: "//trim(mesg)) endif enddo ; enddo - endif - - if (CS%id_chl > 0) then - if (present(chl_in)) then - call post_data(CS%id_chl, chl_in(:,:,1), CS%diag) - else - call post_data(CS%id_chl, chl_data, CS%diag) - endif + else + call MOM_error(FATAL, "Either chl_2d or chl_3d must be preesnt in a call to opacity_form_chl.") endif select case (CS%opacity_scheme) case (MANIZZA_05) -!$OMP parallel do default(none) shared(is,ie,js,je,fluxes,optics,CS,G,multiband_nir_input, & -!$OMP nbands,Inv_nbands_nir,multiband_vis_input ) & -!$OMP private(SW_vis_tot,SW_nir_tot) + !$OMP parallel do default(shared) private(SW_vis_tot,SW_nir_tot) do j=js,je ; do i=is,ie SW_vis_tot = 0.0 ; SW_nir_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then if (multiband_vis_input) then - SW_vis_tot = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + SW_vis_tot = sw_vis_dir(i,j) + sw_vis_dif(i,j) else ! Follow Manizza 05 in assuming that 42% of SW is visible. - SW_vis_tot = 0.42 * fluxes%sw(i,j) + SW_vis_tot = 0.42 * sw_total(i,j) endif if (multiband_nir_input) then - SW_nir_tot = fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) + SW_nir_tot = sw_nir_dir(i,j) + sw_nir_dif(i,j) else - SW_nir_tot = fluxes%sw(i,j) - SW_vis_tot + SW_nir_tot = sw_total(i,j) - SW_vis_tot endif endif @@ -309,17 +331,15 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) enddo enddo ; enddo case (MOREL_88) -!$OMP parallel do default(none) shared(is,ie,js,je,G,multiband_vis_input,chl_data, & -!$OMP fluxes,nbands,optics,Inv_nbands) & -!$OMP private(SW_pen_tot) + !$OMP parallel do default(shared) private(SW_pen_tot) do j=js,je ; do i=is,ie SW_pen_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - (fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j)) + (sw_vis_dir(i,j) + sw_vis_dif(i,j)) else SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - 0.5*fluxes%sw(i,j) + 0.5*sw_total(i,j) endif ; endif do n=1,nbands @@ -328,13 +348,12 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) enddo ; enddo case default call MOM_error(FATAL, "opacity_from_chl: CS%opacity_scheme is not valid.") - end select + end select -!$OMP parallel do default(none) shared(nz,is,ie,js,je,CS,G,chl_in,optics,nbands) & -!$OMP firstprivate(chl_data) + !$OMP parallel do default(shared) firstprivate(chl_data) do k=1,nz - if (present(chl_in)) then - do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,k) ; enddo ; enddo + if (present(chl_3d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,k) ; enddo ; enddo endif select case (CS%opacity_scheme) @@ -376,13 +395,13 @@ end subroutine opacity_from_chl !! Morel and Antoine (1994). function opacity_morel(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: opacity_morel -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! The following are coefficients for the optical model taken from Morel and -! Antoine (1994). These coeficients represent a non uniform distribution of -! chlorophyll-a through the water column. Other approaches may be more -! appropriate when using an interactive ecosystem model that predicts -! three-dimensional chl-a values. + real :: opacity_morel !< The returned opacity [m-1] + + ! The following are coefficients for the optical model taken from Morel and + ! Antoine (1994). These coeficients represent a non uniform distribution of + ! chlorophyll-a through the water column. Other approaches may be more + ! appropriate when using an interactive ecosystem model that predicts + ! three-dimensional chl-a values. real, dimension(6), parameter :: & Z2_coef=(/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2. @@ -396,13 +415,13 @@ function opacity_morel(chl_data) !! 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 :: SW_pen_frac_morel -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! The following are coefficients for the optical model taken from Morel and -! Antoine (1994). These coeficients represent a non uniform distribution of -! chlorophyll-a through the water column. Other approaches may be more -! appropriate when using an interactive ecosystem model that predicts -! three-dimensional chl-a values. + real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim] + + ! The following are coefficients for the optical model taken from Morel and + ! Antoine (1994). These coeficients represent a non uniform distribution of + ! chlorophyll-a through the water column. Other approaches may be more + ! appropriate when using an interactive ecosystem model that predicts + ! three-dimensional chl-a values. real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2. real, dimension(6), parameter :: & V1_coef=(/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) @@ -416,49 +435,510 @@ end function SW_pen_frac_morel !! Manizza, M. et al, 2005. function opacity_manizza(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: opacity_manizza -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! This sets the blue-wavelength opacity according to the scheme proposed by -! Manizza, M. et al, 2005. + real :: opacity_manizza !< The returned opacity [m-1] +! This sets the blue-wavelength opacity according to the scheme proposed by Manizza, M. et al, 2005. opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function -subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) +!> 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) + 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 + 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(max(optics%nbands,1),SZI_(G),SZK_(GV)), & + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. + real, dimension(max(optics%nbands,1),SZI_(G)), & + optional, intent(out) :: penSW_top !< The shortwave radiation [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. + + ! Local variables + real :: scale_opacity, scale_penSW ! Rescaling factors + integer :: i, is, ie, k, nz, n + is = G%isc ; ie = G%iec ; nz = G%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(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 + enddo ; enddo ; endif + +end subroutine extract_optics_slice + +!> Set arguments to fields from the optics type. +subroutine extract_optics_fields(optics, nbands) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer, optional, intent(out) :: nbands !< The number of penetrating bands of SW radiation + + if (present(nbands)) nbands = optics%nbands + +end subroutine extract_optics_fields + +!> Return the number of bands of penetrating shortwave radiation. +function optics_nbands(optics) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer :: optics_nbands !< The number of penetrating bands of SW radiation + + optics_nbands = optics%nbands +end function optics_nbands + +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!! from GOLD) or throughout the water column. +!! +!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total +!! water column thickness is greater than H_limit_fluxes. +!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the +!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. +subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_limit_fluxes, & + adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & + eps, ksort, htot, Ttot, TKE, dSV_dT) + + 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 + integer, intent(in) :: nsw !< Number of bands of penetrating + !! shortwave radiation. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(max(1,nsw),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< Opacity in each band of penetrating + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. + !! The indicies are band, i, k. + type(optics_type), intent(in) :: optics !< An optics structure that has values of + !! opacities and shortwave fluxes. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< If the total ocean depth is + !! less than this, they are scaled away + !! to avoid numerical instabilities + !! [H ~> m or kg m-2]. This would + !! not be necessary if a finite heat + !! capacity mud-layer were added. + logical, intent(in) :: adjustAbsorptionProfile !< If true, apply + !! heating above the layers in which it + !! should have occurred to get the + !! correct mean depth (and potential + !! energy change) of the shortwave that + !! should be absorbed by each layer. + logical, intent(in) :: absorbAllSW !< If true, apply heating above the + !! layers in which it should have occurred + !! to get the correct mean depth (and + !! potential energy change) of the + !! shortwave that should be absorbed by + !! each layer. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer potential/conservative + !! temperatures [degC] + real, dimension(max(1,nsw),SZI_(G)), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in + !! each band that hits the bottom and will + !! will be redistributed through the water + !! column [degC H ~> degC m or degC kg m-2], + !! size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in + !! each layer, and which will not be + !! subject to heating [H ~> m or kg m-2] + integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer + !! temperature [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific + !! volume with temperature [m3 kg-1 degC-1]. + real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating + !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. + + ! Local variables + real, dimension(SZI_(G),SZK_(GV)) :: & + T_chg_above ! A temperature change that will be applied to all the thick + ! layers above a given layer [degC]. This is only nonzero if + ! adjustAbsorptionProfile is true, in which case the net + ! change in the temperature of a layer is the sum of the + ! direct heating of that layer plus T_chg_above from all of + ! the layers below, plus any contribution from absorbing + ! radiation that hits the bottom. + real, dimension(SZI_(G)) :: & + h_heat, & ! The thickness of the water column that will be heated by + ! any remaining shortwave radiation [H ~> m or kg m-2]. + T_chg, & ! The temperature change of thick layers due to the remaining + ! shortwave radiation and contributions from T_chg_above [degC]. + Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave + ! heating that hits the bottom and will be redistributed through + ! the water column [degC H ~> degC m or degC kg m-2] + 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 + 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] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + real :: heat_bnd ! heating due to absorption in the current + ! layer by the current band, including any piece that + ! is moved upward [degC H ~> degC m or degC kg m-2] + real :: SWa ! fraction of the absorbed shortwave that is + ! moved to layers above with adjustAbsorptionProfile [nondim] + real :: coSWa_frac ! The fraction of SWa that is actually moved upward. + real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] + real :: epsilon ! A small thickness that must remain in each + ! layer, and which will not be subject to heating [H ~> m or kg m-2] + real :: g_Hconv2 ! A conversion factor for use in the TKE calculation + ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + logical :: TKE_calc ! If true, calculate the implications to the + ! TKE budget of the shortwave heating. + real :: C1_6, C1_60 + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + min_SW_heat = optics%PenSW_flux_absorb * dt + I_Habs = optics%PenSW_absorb_Invlen + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 + + TKE_calc = (present(TKE) .and. present(dSV_dT)) + + if (optics%answers_2018) then + g_Hconv2 = (US%m_to_Z**2 * US%L_to_Z**2*GV%g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + else + g_Hconv2 = US%m_to_Z**2 * US%L_to_Z**2*GV%g_Earth * GV%H_to_kg_m2**2 + endif + + h_heat(:) = 0.0 + if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do ks=1,nz ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) + + T_chg_above(i,k) = 0.0 + + if (h(i,k) > 1.5*epsilon) 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) * opacity_band(n,i,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several + ! thin layers without further penetration. + if (optics%answers_2018) then + if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 + elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then + if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then + SW_trans = 0.0 + else + SW_trans = min(SW_trans, & + 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i))) + endif + endif + + Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) + if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then + ! In this case, a fraction of the heating is applied to the + ! overlying water so that the mean pressure at which the shortwave + ! heating occurs is exactly what it would have been with a careful + ! pressure-weighted averaging of the exponential heating profile, + ! hence there should be no TKE budget requirements due to this + ! layer. Very clever, but this is also limited so that the + ! water above is not heated at a faster rate than the layer + ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) + ! and takes the energetics of the rest of the heating into account. + ! (-RWH, ~7 years later.) + if (opt_depth > 1e-5) then + SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & + ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & + (1.0 - exp_OD)) + else + ! Use Taylor series expansion of the expression above for a + ! more accurate form with very small layer optical depths. + SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & + ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) + endif + coSWa_frac = 0.0 + if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then + coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & + (SWa*(h_heat(i) + h(i,k))) + SWa = h_heat(i) / (h_heat(i) + h(i,k)) + endif + + T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) + T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) + else + coSWa_frac = 1.0 + T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) + endif + + if (TKE_calc) then + if (opt_depth > 1e-2) then + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) + else + ! Use Taylor series-derived approximation to the above expression + ! that is well behaved and more accurate when opt_depth is small. + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) + endif + endif + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + endif ; enddo + endif + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ; enddo ! i & k loops + + +! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return + + ! Unless modified, there is no temperature change due to fluxes from the bottom. + do i=is,ie ; T_chg(i) = 0.0 ; enddo + + if (absorbAllSW) then + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit >= 1.0) then + T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 + else + T_chg(i) = Pen_SW_rem(i) * Ih_limit + unabsorbed = 1.0 - h_heat(i)*Ih_limit + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + endif ! absorbAllSW + + if (absorbAllSW .or. adjustAbsorptionProfile) then + do ks=nz,1,-1 ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + + if (T_chg(i) > 0.0) then + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) + elseif (h(i,k) > h_min_heat) then + T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) + endif + endif + ! Increase the heating for layers above. + T_chg(i) = T_chg(i) + T_chg_above(i,k) + enddo ; enddo + if (present(htot) .and. present(Ttot)) then + do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo + endif + endif ! absorbAllSW .or. adjustAbsorptionProfile + +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 updat e the state. +subroutine sumSWoverBands(G, GV, US, h, 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]. + 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 + !! set based on the opacities. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< the total depth at which the + !! surface fluxes start to be limited to avoid + !! excessive heating of a thin ocean [H ~> m or kg m-2] + logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave + !! radiation is absorbed in the ocean water column. + real, dimension(max(nsw,1),SZI_(G)), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave + !! heating in each band that hits the bottom and + !! will be redistributed through the water column + !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(GV)+1), & + intent(inout) :: netPen !< Net penetrating shortwave heat flux at each + !! interface, summed across all bands + !! [degC H ~> degC m or degC kg m-2]. + ! Local variables + real :: h_heat(SZI_(G)) ! thickness of the water column that receives + ! remaining shortwave radiation [H ~> m or kg m-2]. + real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the + ! penetrating shortwave heating that hits the bottom + ! and will be redistributed through the water column + ! [degC H ~> degC m or degC kg m-2] + + real, dimension(max(nsw,1),SZI_(G)) :: Pen_SW_bnd ! The remaining penetrating shortwave radiation + ! in each band, initially iPen_SW_bnd [degC H ~> degC m or degC kg m-2] + real :: SW_trans ! fraction of shortwave radiation not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation + ! not absorbed because the layers are too thin. + 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 :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + real :: I_Habs ! The inverse of the absorption length for a minimal flux [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] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H + I_Habs = 1e3*GV%H_to_m ! optics%PenSW_absorb_Invlen + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) + do i=is,ie ; h_heat(i) = 0.0 ; enddo + netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do k=1,nz + + do i=is,ie + netPen(i,k+1) = 0. + + 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_m * optics%opacity_band(n,i,j,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several + ! thin layers without further penetration. + if (optics%answers_2018) then + if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 + elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then + if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then + SW_trans = 0.0 + else + SW_trans = min(SW_trans, & + 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i))) + endif + endif + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) + endif ; enddo + endif ! h(i,k) > 0.0 + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ! i loop + enddo ! k loop + + if (absorbAllSW) then + + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit < 1.0) then + unabsorbed = 1.0 - h_heat(i)*Ih_limit + else + unabsorbed = 0.0 + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + + endif ! absorbAllSW + +end subroutine sumSWoverBands + + + +!> This routine initalizes the opacity module, including an optics_type. +subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) type(time_type), target, 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 !< model 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. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(tracer_flow_control_CS), & - target, intent(in) :: tracer_flow !< A pointer to the tracer flow control - !! module's control structure type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. type(optics_type), pointer :: optics !< An optics structure that has parameters !! set and arrays allocated here. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=200) :: inputdir ! The directory where NetCDF input files - character(len=240) :: filename + ! Local variables character(len=200) :: tmpstr character(len=40) :: mdl = "MOM_opacity" character(len=40) :: bandnum, shortname character(len=200) :: longname character(len=40) :: scheme_string + ! This include declares and sets the variable "version". +# include "version_variable.h" + 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 [m]. + real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] + logical :: default_2018_answers logical :: use_scheme - character(len=128) :: chl_file ! Data containing chl_a concentrations. Used - ! when var_pen_sw is defined and reading from file. - character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -469,8 +949,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) else ; allocate(CS) ; endif CS%diag => diag - CS%Time => Time - CS%tracer_flow_CSp => tracer_flow ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, '') @@ -509,23 +987,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%opacity_scheme = MANIZZA_05 ; scheme_string = MANIZZA_05_STRING endif - call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & - "If true, chl_a is read from a file.", default=.true.) - if (CS%chl_from_file) then - call time_interp_external_init() - - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - call get_param(param_file, mdl, "CHL_FILE", chl_file, & - "CHL_FILE is the file containing chl_a concentrations in "//& - "the variable CHL_A. It is used when VAR_PEN_SW and "//& - "CHL_FROM_FILE are true.", fail_if_missing=.true.) - filename = trim(slasher(inputdir))//trim(chl_file) - call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", filename) - call get_param(param_file, mdl, "CHL_VARNAME", chl_varname, & - "Name of CHL_A variable in CHL_FILE.", default='CHL_A') - CS%sbc_chl = init_external_field(filename,trim(chl_varname),domain=G%Domain%mpp_domain) - endif - call get_param(param_file, mdl, "BLUE_FRAC_SW", CS%blue_frac, & "The fraction of the penetrating shortwave radiation "//& "that is in the blue band.", default=0.5, units="nondim") @@ -575,16 +1036,36 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) "The number of bands of penetrating shortwave radiation.", & default=1) if (CS%Opacity_scheme == DOUBLE_EXP ) then - if (optics%nbands /= 2) then - call MOM_error(FATAL, "set_opacity: "// & - "Cannot use a double_exp opacity scheme with nbands!=2.") - endif + if (optics%nbands /= 2) call MOM_error(FATAL, & + "set_opacity: \Cannot use a double_exp opacity scheme with nbands!=2.") elseif (CS%Opacity_scheme == SINGLE_EXP ) then - if (optics%nbands /= 1) then - call MOM_error(FATAL, "set_opacity: "// & - "Cannot use a single_exp opacity scheme with nbands!=1.") - endif + if (optics%nbands /= 1) call MOM_error(FATAL, & + "set_opacity: \Cannot use a single_exp opacity scheme with nbands!=1.") endif + + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", optics%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) + + 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 "//& + "the next sufficiently thick layers for computational efficiency, instead of "//& + "continuing to penetrate. The default, 2.5e-11 degC m s-1, is about 1e-4 W m-2 "//& + "or 0.08 degC m century-1, but 0 is also a valid value.", & + default=2.5e-11, units="degC m s-1", scale=GV%m_to_H*US%T_to_s) + + if (optics%answers_2018) then ; PenSW_minthick_dflt = 0.001 ; else ; PenSW_minthick_dflt = 1.0 ; endif + call get_param(param_file, mdl, "PEN_SW_ABSORB_MINTHICK", PenSW_absorb_minthick, & + "A thickness that is used to absorb the remaining penetrating shortwave heat "//& + "flux when it drops below PEN_SW_FLUX_ABSORB.", & + default=PenSW_minthick_dflt, units="m", scale=GV%m_to_H) + optics%PenSW_absorb_Invlen = 1.0 / (PenSW_absorb_minthick + GV%H_subroundoff) + if (.not.associated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) if (.not.associated(optics%max_wavelength_band)) & @@ -622,14 +1103,11 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) do n=1,optics%nbands write(bandnum,'(i3)') n shortname = 'opac_'//trim(adjustl(bandnum)) - longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) + longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) & + // ', saved as L^-1 tanh(Opacity * L) for L = 10^-10 m' CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & longname, 'm-1') enddo - if (CS%var_pen_sw) & - CS%id_chl = register_diag_field('ocean_model', 'Chl_opac', diag%axesT1, Time, & - 'Surface chlorophyll A concentration used to find opacity', 'mg m-3') - end subroutine opacity_init @@ -650,18 +1128,18 @@ end subroutine opacity_end !> \namespace mom_opacity !! -!! CHL_from_file: -!! In this routine, the Morel (modified) and Manizza (modified) +!! opacity_from_chl: +!! In this routine, the Morel (modified) or Manizza (modified) !! schemes use the "blue" band in the paramterizations to determine !! the e-folding depth of the incoming shortwave attenuation. The red !! portion is lumped into the net heating at the surface. !! !! Morel, A., 1988: Optical modeling of the upper ocean in relation -!! to itsbiogenous matter content (case-i waters)., J. Geo. Res., +!! to its biogenous matter content (case-i waters)., J. Geo. Res., !! 93, 10,749-10,768. !! !! Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005: -!! Bio-optical feedbacks amoung phytoplankton, upper ocean physics +!! Bio-optical feedbacks among phytoplankton, upper ocean physics !! and sea-ice in a global model, Geophys. Res. Let., 32, L05603, !! doi:10.1029/2004GL020778. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 82d3eaa547..7d118bc00a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -17,6 +17,7 @@ module MOM_set_diffusivity use MOM_full_convection, only : full_convection use MOM_grid, only : ocean_grid_type use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss +use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_tidal_mixing, only : tidal_mixing_CS, calculate_tidal_mixing use MOM_tidal_mixing, only : setup_tidal_diagnostics, post_tidal_diagnostics use MOM_intrinsic_functions, only : invcosh @@ -30,7 +31,6 @@ module MOM_set_diffusivity use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase -use MOM_thickness_diffuse, only : vert_fill_TS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type @@ -81,9 +81,8 @@ module MOM_set_diffusivity !! 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]. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. - !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness [meter] when BULKMIXEDLAYER==.false. + real :: Kd_smooth !< Vertical diffusivity used to interpolate more + !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 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 @@ -116,6 +115,9 @@ module MOM_set_diffusivity real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below !! mixed layer base [nondim] + logical :: ML_rad_bug !< If true use code with a bug that reduces the energy available + !! in the transition layer by a factor of the inverse of the energy + !! deposition lenthscale (in m). logical :: ML_rad_TKE_decay !< If true, apply same exponential decay !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. @@ -146,6 +148,10 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] + 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. + character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module @@ -196,21 +202,21 @@ module MOM_set_diffusivity !! viscosity associated with processes 1,2 and 4 listed above, which is stored in !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear -subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & +subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, & G, GV, US, CS, 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h !< Zonal velocity interpolated to h points [m s-1]. + intent(in) :: u_h !< Zonal velocity interpolated to h points [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h !< Meridional velocity interpolated to h points [m s-1]. + intent(in) :: v_h !< Meridional velocity interpolated to h points [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -218,7 +224,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !! properties of the ocean. type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. @@ -263,8 +269,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed - real :: kappa_fill ! diffusivity used to fill massless layers [Z2 T-1 ~> m2 s-1] - real :: dt_fill ! timestep used to fill massless layers [T ~> s] + real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [Z2 ~> m2] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -276,8 +281,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & I_Rho0 = 1.0 / GV%Rho0 ! ### Dimensional parameters - kappa_fill = 1.e-3 * US%m2_s_to_Z2_T - dt_fill = 7200. * US%s_to_T + if (CS%answers_2018) then + kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200. + else + kappa_dt_fill = CS%Kd_smooth * dt_in_T + endif Omega2 = CS%omega * CS%omega use_EOS = associated(tv%eqn_of_state) @@ -291,7 +299,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! If nothing else is specified, this will be the value used. Kd_lay(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = US%s_to_T * CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -330,7 +338,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(tv%S, "before vert_fill_TS tv%S",G%HI) 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_fill, dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, larger_h_denom=.true.) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T",G%HI) call hchksum(tv%S, "after vert_fill_TS tv%S",G%HI) @@ -346,25 +354,24 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, h, tv, T_adj, S_adj, fluxes%p_surf, & - (GV%Z_to_H**2)*kappa_fill*dt_fill, halo=1) + (GV%Z_to_H**2)*kappa_dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & - visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) + visc%TKE_turb, visc%Kv_shear_Bu, dt_in_T, 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%Z_to_m**2) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z_to_m**2) - call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) + 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 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 - ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) - ! Sets visc%Kv_shear + ! Changes: visc%Kd_shear ; Sets: visc%Kv_shear and visc%TKE_turb 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) + visc%Kv_shear, dt_in_T, 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%Z_to_m**2) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z_to_m**2) - call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) + 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%TKE_turb, "after calc_KS visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif endif call cpu_clock_end(id_clock_kappaShear) @@ -373,8 +380,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !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%Z_to_m**2) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z_to_m**2) + 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) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled @@ -408,12 +415,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KT_extra(i,K) Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = US%s_to_T * (KS_extra(i,K) - KT_extra(i,K)) + visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KS_extra(i,K) Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = US%s_to_T * (KT_extra(i,K) - KS_extra(i,K)) + visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -441,15 +448,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = (US%T_to_s * visc%Kd_shear(i,j,K)) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = US%T_to_s * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%T_to_s * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then @@ -462,7 +469,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, (US%s_to_T)*dt, G, GV, US, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt_in_T, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) @@ -486,7 +493,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, G, GV, US, CS, & Kd_lay, Kd_int, dd%Kd_BBL) else - call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & + call add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, dd%Kd_BBL) endif endif @@ -523,19 +530,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & enddo ! j-loop if (CS%debug) then - call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay ,"Kd_lay", 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=US%Z_to_m**2) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true., scale=US%Z_to_m**2) + G%HI, 0, symmetric=.true., scale=US%Z2_T_to_m2_s) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then @@ -544,7 +550,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m*US%s_to_T) endif endif @@ -670,8 +676,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 T-2 kg-1 -> m4 s-2 kg-1] - real :: G_IRho0 ! ### Alternate calculation of G_Rho0 for reproducibility + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z m3 T-2 kg-1 -> m4 s-2 kg-1] + real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z m3 T-2 kg-1 -> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] real :: I_dt ! 1/dt [T-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] @@ -684,12 +690,13 @@ 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 and G_IRho0 are mathematically identical but give different - ! numerical values. We compute both values for now, but they should be - ! consolidated at some point. - G_Rho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 - I_Rho0 = 1.0 / GV%Rho0 - G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 + if (CS%answers_2018) then + I_Rho0 = 1.0 / GV%Rho0 + G_IRho0 = (US%L_to_Z**2 * GV%g_Earth) * I_Rho0 + else + G_IRho0 = G_Rho0 + endif ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then @@ -732,11 +739,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo enddo - call set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) + call set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) else ! not bulkmixedlayer kb_min = 2 ; kmb = 0 do i=is,ie ; kb(i) = 1 ; enddo - call set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1) + call set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1) endif ! Determine maxEnt - the maximum permitted entrainment from below by each @@ -767,8 +774,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & if (k == kb(i)) then maxEnt(i,kb(i)) = mFkb(i) elseif (k > kb(i)) then - maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) -! maxEnt(i,k) = ds_dsp1(i,k)*(maxEnt(i,k-1) + htot(i)) ! BITWISE CHG + if (CS%answers_2018) then + maxEnt(i,k) = (1.0/dsp1_ds(i,k))*(maxEnt(i,k-1) + htot(i)) + 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) endif enddo ; enddo @@ -809,16 +819,18 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & TKE_to_Kd(i,k) = 0.0 else ! maxTKE is found by determining the kappa that gives maxEnt. - ! ### This should be 1 / G_Earth * (delta rho_InSitu) ! kappa_max = I_dt * dRho_int(i,K+1) * maxEnt(i,k) * & - ! (GV%H_to_m*h(i,j,k) + dh_max) / dRho_lay - ! maxTKE(i,k) = (GV%g_Earth*US%m_to_Z) * dRho_lay * kappa_max + ! (GV%H_to_Z*h(i,j,k) + dh_max) / dRho_lay + ! maxTKE(i,k) = (GV%g_Earth*US%L_to_Z**2) * dRho_lay * kappa_max ! dRho_int should already be non-negative, so the max is redundant? dh_max = maxEnt(i,k) * (1.0 + dsp1_ds(i,k)) dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) maxTKE(i,k) = I_dt * (G_IRho0 * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) + ! TKE_to_Kd should be rho_InSitu / G_Earth * (delta rho_InSitu) + ! The omega^2 term in TKE_to_Kd is due to a rescaling of the efficiency of turbulent + ! mixing by a factor of N^2 / (N^2 + Omega^2), as proposed by Melet et al., 2013? TKE_to_Kd(i,k) = 1.0 / (G_Rho0 * dRho_lay + & CS%omega**2 * GV%H_to_Z*(h(i,j,k) + H_neglect)) endif @@ -878,7 +890,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 = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1093,9 +1105,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1166,7 +1178,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0 / (US%m_to_Z**2 * US%T_to_s**2 * GV%g_Earth) + R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1176,9 +1188,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = US%T_to_s * visc%ustar_BBL(i,j) + ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & - ustar_h = ustar_h + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + ustar_h = ustar_h + fluxes%ustar_tidal(i,j) 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 @@ -1249,8 +1261,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & else ; TKE_to_layer = 0.0 ; endif ! TKE_Ray has been initialized to 0 above. - if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & - US%m_to_Z**2 * US%T_to_s**3 * & + if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1285,8 +1296,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & elseif (Kd_lay(i,j,k) + (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) > & maxTKE(i,k) * TKE_to_Kd(i,k)) then TKE_here = ((TKE_to_layer + TKE_Ray) + Kd_lay(i,j,k) / TKE_to_Kd(i,k)) - maxTKE(i,k) - ! ### Non-bracketed ternary sum - TKE(i) = TKE(i) - TKE_here + TKE_Ray + TKE(i) = (TKE(i) - TKE_here) + TKE_Ray else TKE_here = TKE_to_layer + TKE_Ray TKE(i) = TKE(i) - TKE_to_layer @@ -1330,9 +1340,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< u component of flow [m s-1] + intent(in) :: u !< u component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< v component of flow [m s-1] + intent(in) :: v !< v component of flow [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available @@ -1393,12 +1403,13 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & 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 [m s-1]. - ustar = US%T_to_s * visc%ustar_BBL(i,j) + ! u* at the bottom [Z T-1 ~> m 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 - if (associated(fluxes%ustar_tidal)) ustar = ustar + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + !### Examine this question of whether there is double counting of fluxes%ustar_tidal. + if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) ! 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. @@ -1430,8 +1441,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - US%m_to_Z**2 * US%T_to_s**3 * & - 0.5*CS%BBL_effic * G%IareaT(i,j) * & + 0.5*CS%BBL_effic * US%L_to_Z**2 * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1548,9 +1558,9 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, f_sq = CS%ML_omega_frac * 4.0 * Omega2 + (1.0 - CS%ML_omega_frac) * f_sq endif - ustar_sq = max(US%T_to_s * fluxes%ustar(i,j), CS%ustar_min)**2 + ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (US%T_to_s * fluxes%ustar(i,j))) + TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (fluxes%ustar(i,j))) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & @@ -1588,14 +1598,23 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, 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) - if (z1 > 1e-5) then - !### I think that this might be dimensionally inconsistent, but untested. -RWH - 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 ? + if (CS%ML_Rad_bug) then + ! These expresssions 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 + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 + endif else - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 ? + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (1.0 - exp(-z1)) + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) + endif endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1621,9 +1640,9 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes @@ -1639,15 +1658,15 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! integrated thickness in the BBL [Z ~> m]. real, dimension(SZIB_(G)) :: & - uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] - ustar, & ! bottom boundary layer turbulence speed [Z s-1 ~> m s-1]. - u2_bbl ! square of the mean zonal velocity in the BBL [m2 s-2] + 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]. + 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 m s-1 ~> m2 s-1] + 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 s-1 ~> m s-1]. - v2_bbl ! square of average meridional velocity in BBL [m2 s-2] + vstar, & ! ustar at at v-points [Z T-1 ~> m s-1]. + v2_bbl ! square of average meridional velocity in BBL [L2 T-2 ~> m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: hvel ! thickness at velocity points [Z ~> m]. @@ -1681,7 +1700,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1711,7 +1730,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo @@ -1742,7 +1761,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%T_to_s**3 * US%m_to_Z**2 * & + visc%TKE_BBL(i,j) = US%L_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & @@ -1753,7 +1772,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) end subroutine set_BBL_TKE -subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) +subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) 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)), & @@ -1763,6 +1782,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) !! fields have NULL ptrs. integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(set_diffusivity_CS), pointer :: CS !< Control structure returned by previous !! call to diabatic_entrain_init. integer, intent(in) :: j !< Meridional index upon which to work. @@ -1775,7 +1795,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) !! surface press [kg m-3]. ! Local variables - real :: g_R0 ! g_R0 is g/Rho [m5 Z-1 kg-1 s-2 ~> m4 kg-1 s-2] + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [m3 L2 Z-1 kg-1 T-2 ~> m4 kg-1 s-2] real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures @@ -1786,7 +1806,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) is = G%isc ; ie = G%iec ; nz = G%ke do k=2,nz-1 - if (GV%g_prime(k+1)/=0.) then + 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 @@ -1798,7 +1818,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%g_Earth/GV%Rho0 + g_R0 = GV%g_Earth / GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo @@ -1875,13 +1895,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. - ! local variables + ! Local variables real :: decay_length logical :: ML_use_omega - -! This include declares and sets the variable "version". -#include "version_variable.h" - + logical :: default_2018_answers + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. real :: omega_frac_dflt integer :: i, j, is, ie, js, je @@ -1903,7 +1922,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! These default values always need to be set. CS%BBL_mixing_as_max = .true. - CS%Kdml = 0.0 ; CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 + CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 CS%bulkmixedlayer = (GV%nkml > 0) ! Read all relevant parameters and write them to the model log. @@ -1920,6 +1939,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, scale=US%T_to_s) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", CS%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) + call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& "work to penetrate below the base of the mixed layer "//& @@ -1935,6 +1962,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "depth for turbulence below the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", units="nondim", & default=0.2) + call get_param(param_file, mdl, "ML_RAD_BUG", CS%ML_rad_bug, & + "If true use code with a bug that reduces the energy available "//& + "in the transition layer by a factor of the inverse of the energy "//& + "deposition lenthscale (in m).", default=.true.) call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence "//& "radiated from the base of the mixed layer. "//& @@ -1989,13 +2020,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "bottom drag drives BBL diffusion. This is only "//& "used if BOTTOMDRAGLAW is true.", units="nondim", default=0.20) call get_param(param_file, mdl, "BBL_MIXING_MAX_DECAY", decay_length, & - "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 is 0. "//& - "This is only used if BOTTOMDRAGLAW is true.", & - units="m", default=0.0, scale=US%m_to_Z) + "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) - CS%IMax_decay = 1.0 / (200.0*US%m_to_Z) !### This is inconsistent with the description above. + CS%IMax_decay = 0.0 if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the "//& @@ -2056,28 +2086,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ 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.", & + default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) - if (CS%bulkmixedlayer) then - ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) - if (CS%Kdml>0.) call MOM_error(FATAL, & - "set_diffusivity_init: KDML cannot be set when using"// & - "bulk mixed layer.") - CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also - ! cannot be a NaN. - else - ! ### This parameter is unused and is staged for deletion - call get_param(param_file, mdl, "KDML", CS%Kdml, & - "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) - 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", fail_if_missing=.true.) - endif call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 2180a62cc4..450ccdb05a 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -47,15 +47,15 @@ module MOM_set_visc real :: c_Smag !< The Laplacian Smagorinsky coefficient for !! calculating the drag in channels. real :: drag_bg_vel !< An assumed unresolved background velocity for - !! calculating the bottom drag [m s-1]. + !! calculating the bottom drag [L T-1 ~> m s-1]. real :: BBL_thick_min !< The minimum bottom boundary layer thickness [H ~> m or kg m-2]. !! 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 s-1 ~> m2 s-1]. - real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 s-1 ~> m2 s-1]. + 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]. 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 @@ -72,15 +72,18 @@ module MOM_set_visc !! determine the mixed layer thickness for viscosity. real :: bulk_Ri_ML !< The bulk mixed layer used to determine the !! thickness of the viscous mixed layer. Nondim. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems [Z s-1 ~> m s-1]. If the value is small enough, + !! problems [Z T-1 ~> m 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, nondimensional. real :: omega_frac !< When setting the decay scale for turbulence, use !! this fraction of the absolute rotation rate blended !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + 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 :: debug !< If true, write verbose checksums for debugging purposes. type(ocean_OBC_type), pointer :: OBC => NULL() !< Open boundaries control structure type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -108,9 +111,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -126,7 +129,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Local variables real, dimension(SZIB_(G)) :: & - ustar, & ! The bottom friction velocity [Z s-1 ~> m s-1]. + ustar, & ! The bottom friction velocity [Z T-1 ~> m s-1]. T_EOS, & ! The temperature used to calculate the partial derivatives ! of density with T and S [degC]. S_EOS, & ! The salinity used to calculate the partial derivatives @@ -168,7 +171,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> 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 m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -179,7 +182,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! 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 :: C2f ! C2f = 2*f at velocity points. + real :: C2f ! C2f = 2*f at velocity points [T-1 ~> s-1]. real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean @@ -188,14 +191,14 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H T T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl ! of the bottom [H ~> m or kg m-2]. - real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. + 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 - ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! 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 [kg m-3]. @@ -228,9 +231,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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]. real :: L(SZK_(G)+1) ! The fraction of the full cell width that is open at - ! the depth of each interface, nondimensional. + ! 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. + real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. real :: Vol_err_max ! The volume errors for the upper and lower bounds on real :: Vol_err_min ! 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]. @@ -240,10 +243,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! evaluated at L=L0 [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 :: ustH ! ustar converted to units of H s-1 [H s-1 ~> m s-1 or kg m-2 s-1]. - real :: root ! A temporary variable [H s-1 ~> m s-1 or kg m-2 s-1]. + 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 [m]. + 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 ~> 1]. @@ -266,7 +269,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H + 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 C2pi_3 = 8.0*atan(1.0)/3.0 @@ -279,7 +282,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif if (CS%debug) then - call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1) + call uvchksum("Start set_viscous_BBL [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) 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) if (associated(tv%S)) call hchksum(tv%S, "Start set_viscous_BBL S", G%HI, haloshift=1) @@ -290,7 +293,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) K2 = max(nkmb+1, 2) ! With a linear drag law, the friction velocity is already known. @@ -626,8 +629,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The bottom boundary layer thickness is found by solving the same ! equation as in Killworth and Edwards: (h/h_f)^2 + h/h_N = 1. - if (m==1) then ; C2f = US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) - else ; C2f = US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif + if (m==1) then ; C2f = G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J) + else ; C2f = G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J) ; endif if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, @@ -640,7 +643,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) + ((ustar(i)*ustar(i)) * (GV%Z_to_H**2)) ) ) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -770,18 +773,19 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) 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) - !### The following code is more robust when GV%Angstrom_H=0, but it - !### changes answers. - ! 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) - - ! if (dVol <= 0.0) then - ! L(K) = L0 - ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol - ! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * & - ! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then - if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then + ! The following code is more robust when GV%Angstrom_H=0, but it changes answers. + if (.not.CS%answers_2018) then + 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) + endif + + if ((.not.CS%answers_2018) .and. (dVol <= 0.0)) then + L(K) = L0 + Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol + elseif ( ((.not.CS%answers_2018) .and. & + (a*a*dVol**3 < Vol_tol*dV_dL2**2 *(dV_dL2*Vol_tol - 2.0*a*L0*dVol))) .or. & + (CS%answers_2018 .and. (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & + (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol) )) ) 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) @@ -818,7 +822,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acting on each layer. + ! and the Raleigh drag that acts on each layer. if (L(K) > L(K+1)) then if (vol_below < bbl_thick) then BBL_frac = (1.0-vol_below/bbl_thick)**2 @@ -830,9 +834,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then ; Cell_width = G%dy_Cu(I,j) else ; Cell_width = G%dx_Cv(i,J) ; endif gam = 1.0 - L(K+1)/L(K) - Rayleigh = US%m_to_Z * CS%cdrag * (L(K)-L(K+1)) * (1.0-BBL_frac) * & + Rayleigh = US%L_to_Z * CS%cdrag * (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 + & - GV%m_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) + US%L_to_Z*GV%Z_to_H * CS%cdrag * gam*(1.0-gam)*(1.0-1.5*gam) * L(K)**2 * Cell_width) else ! This layer feels no drag. Rayleigh = 0.0 endif @@ -855,11 +859,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & + visc%Kv_bbl_u(I,j) = max(CS%Kv_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & + visc%Kv_bbl_v(i,J) = max(CS%Kv_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_v(i,J) = bbl_thick_Z endif @@ -869,10 +873,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! the correct stress when the shear occurs over bbl_thick. bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%Kv_bbl_u(I,j) = max(CS%Kv_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%Kv_bbl_v(i,J) = max(CS%Kv_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_v(i,J) = bbl_thick_Z endif endif @@ -897,7 +901,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z_to_m**2) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (associated(visc%bbl_thick_u) .and. associated(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) @@ -909,7 +913,7 @@ end subroutine set_viscous_BBL function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1] + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -918,7 +922,8 @@ function set_v_at_u(v, h, G, i, j, k, mask2dCv, OBC) real, dimension(SZI_(G),SZJB_(G)),& intent(in) :: mask2dCv !< A multiplicative mask of the v-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_v_at_u !< The retur value of v at u points [m s-1]. + real :: set_v_at_u !< The return value of v at u points points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of v at the u-points. real :: hwt(0:1,-1:0) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -952,7 +957,7 @@ end function set_v_at_u function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1] + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1] or other units. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] integer, intent(in) :: i !< The i-index of the u-location to work on. @@ -961,7 +966,8 @@ function set_u_at_v(u, h, G, i, j, k, mask2dCu, OBC) real, dimension(SZIB_(G),SZJ_(G)), & intent(in) :: mask2dCu !< A multiplicative mask of the u-points type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure - real :: set_u_at_v !< The return value of u at v points [m s-1]. + real :: set_u_at_v !< The return value of u at v points in the + !! same units as u, i.e. [L T-1 ~> m s-1] or other units. ! This subroutine finds a thickness-weighted value of u at the v-points. real :: hwt(-1:0,0:1) ! Masked weights used to average u onto v [H ~> m or kg m-2]. @@ -1001,9 +1007,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. + intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. + intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -1018,6 +1024,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri logical, optional, intent(in) :: symmetrize !< If present and true, do extra calculations !! of those values in visc that would be !! calculated with symmetric memory. + ! Local variables real, dimension(SZIB_(G)) :: & htot, & ! The total depth of the layers being that are within the @@ -1030,13 +1037,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! [H kg m-3 ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [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 [kg m-3 ppt-1]. - ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. + ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [ppt]. @@ -1055,12 +1062,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the ! interior layer layer times the depth of the the mixed layer - ! [H2 m2 s-2 ~> m4 s-2 or kg2 m-2 s-2]. + ! [H2 Z2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity 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]. @@ -1071,23 +1078,23 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri real :: S_lay ! The layer salinity at velocity points [ppt]. real :: Rlay ! The layer potential density at velocity points [kg m-3]. real :: Rlb ! The potential density of the layer below [kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point [m s-1]. - real :: u_at_v ! The zonal velocity at a meridonal velocity point [m s-1]. + real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. + real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across - ! the base of the mixed layer [m2 s-2]. + ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. real :: RiBulk ! The bulk Richardson number below which water is in the ! viscous mixed layer, including reduction for turbulent ! decay. Nondimensional. real :: dt_Rho0 ! The time step divided by the conversion from the layer ! thickness to layer mass [s H m2 kg-1 ~> s m3 kg-1 or s]. real :: g_H_Rho0 ! The gravitational acceleration times the conversion from H to m divided - ! by the mean density [m5 s-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. + ! by the mean density [L2 m3 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: ustarsq ! 400 times the square of ustar, times ! Rho0 divided by G_Earth and the conversion ! from m to thickness units [H kg m-3 ~> 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 m-1 ~> 1]. + ! factor from lateral lengths to vertical depths [Z L-1 ~> 1]. real :: cdrag_sqrt ! Square root of the drag coefficient [nondim]. real :: oldfn ! The integrated energy required to ! entrain up to the bottom of the layer, @@ -1098,18 +1105,18 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the present layer [H ~> m or kg m-2]. 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 [m2 s-2]. + ! 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, s-1. - real :: U_star ! The friction velocity at velocity points [Z s-1 ~> m s-1]. + 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 :: 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 :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. - real :: ustar1 ! ustar [H s-1 ~> m s-1 or kg m-2 s-1] - real :: h2f2 ! (h*2*f)^2 [H2 s-2 ~> m2 s-2 or kg2 m-4 s-2] + 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)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n type(ocean_OBC_type), pointer :: OBC => NULL() @@ -1127,10 +1134,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%g_Earth)) * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) - cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) + cdrag_sqrt_Z = US%L_to_Z * sqrt(CS%cdrag) OBC => CS%OBC use_EOS = associated(tv%eqn_of_state) @@ -1198,12 +1205,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(I) = .true. ; do_any = .true. k_massive(I) = nkml Thtot(I) = 0.0 ; Shtot(I) = 0.0 ; Rhtot(i) = 0.0 - uhtot(I) = dt_Rho0 * forces%taux(I,j) - vhtot(I) = 0.25 * dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & + uhtot(I) = US%m_s_to_L_T*dt_Rho0 * forces%taux(I,j) + vhtot(I) = 0.25 * US%m_s_to_L_T*dt_Rho0 * ((forces%tauy(i,J) + forces%tauy(i+1,J-1)) + & (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) + absf = 0.5*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1235,7 +1242,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i+1,j,k)) v_at_u = 0.5 * (h(i,j,k) * (v(i,J,k) + v(i,J-1,k)) + & h(i+1,j,k) * (v(i+1,J,k) + v(i+1,J-1,k))) * I_2hlay - Uh2 = (uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2 + Uh2 = ((uhtot(I) - htot(I)*u(I,j,k))**2 + (vhtot(I) - htot(I)*v_at_u)**2) 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 @@ -1332,9 +1339,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z*hutot/hwtot + ustar(I) = cdrag_sqrt_Z * hutot/hwtot else - ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z * CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1406,14 +1413,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & - ! (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & + ! (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 - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + 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) + visc%Kv_tbl_shelf_u(I,j) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1433,12 +1440,12 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri do_i(i) = .true. ; do_any = .true. k_massive(i) = nkml Thtot(i) = 0.0 ; Shtot(i) = 0.0 ; Rhtot(i) = 0.0 - vhtot(i) = dt_Rho0 * forces%tauy(i,J) - uhtot(i) = 0.25 * dt_Rho0 * ((forces%taux(I,j) + forces%taux(I-1,j+1)) + & + vhtot(i) = US%m_s_to_L_T*dt_Rho0 * forces%tauy(i,J) + uhtot(i) = 0.25 * US%m_s_to_L_T*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*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + 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 @@ -1472,7 +1479,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri I_2hlay = 1.0 / (h(i,j,k) + h(i,j+1,k)) u_at_v = 0.5 * (h(i,j,k) * (u(I-1,j,k) + u(I,j,k)) + & h(i,j+1,k) * (u(I-1,j+1,k) + u(I,j+1,k))) * I_2hlay - Uh2 = (uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2 + Uh2 = ((uhtot(I) - htot(I)*u_at_v)**2 + (vhtot(I) - htot(I)*v(i,J,k))**2) 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 @@ -1569,9 +1576,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z*hutot/hwtot + ustar(i) = cdrag_sqrt_Z * hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z * CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1643,14 +1650,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & - ! (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & + ! (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 - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + 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) + visc%Kv_tbl_shelf_v(i,J) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop endif ! do_any_shelf @@ -1722,17 +1729,12 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) 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 register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, & - "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", & - hor_grid="Bu", z_grid='i') 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", "m2 s-1", & hor_grid="Bu", z_grid='i') elseif (use_kappa_shear) then call safe_alloc_ptr(visc%TKE_turb, isd, ied, jsd, jed, nz+1) - call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, & - "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", z_grid='i') endif if (useKPP) then @@ -1776,19 +1778,25 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! structure for this module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure + ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt - real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a reastart fole to the internal representation in this run. + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a restart file to the internal representation in this run. + real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run + ! to the representation in a restart file. + real :: Z2_T_rescale ! A rescaling factor for vertical diffusivities and viscosities from the + ! representation in a restart file to the internal representation in this run. integer :: i, j, k, is, ie, js, je, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + logical :: default_2018_answers logical :: use_kappa_shear, adiabatic, use_omega logical :: use_CVMix_ddiff, differential_diffusion, use_KPP type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. if (associated(CS)) then @@ -1810,6 +1818,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. differential_diffusion = .false. + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", CS%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) 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 "//& @@ -1883,13 +1898,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + 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) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_s) endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & @@ -1909,7 +1924,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& "velocity magnitude. DRAG_BG_VEL is only used when "//& - "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0) + "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & "If true, use the equation of state in determining the "//& "properties of the bottom boundary layer. Otherwise use "//& @@ -1945,10 +1960,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=Kv_background, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_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=Kv_background, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -1967,8 +1982,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then - ! These are necessary for reproduciblity across restarts in non-symmetric mode. - call pass_var(visc%TKE_turb, G%Domain, position=CORNER, complete=.false.) + ! This is necessary for reproduciblity across restarts in non-symmetric mode. call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.) endif @@ -1983,19 +1997,19 @@ 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%Z_to_m**2) + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) 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%Z_to_m**2) + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 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) + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_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) + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) endif if (use_CVMix_ddiff .or. differential_diffusion) then @@ -2015,23 +2029,32 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then + ! Account for possible changes in dimensional scaling for variables that have been + ! read from a restart file. + Z_rescale = 1.0 + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) & Z_rescale = US%m_to_Z / US%m_to_Z_restart + I_T_rescale = 1.0 + if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & + I_T_rescale = US%s_to_T_restart / US%s_to_T + Z2_T_rescale = Z_rescale**2*I_T_rescale + + if (Z2_T_rescale /= 1.0) then if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) + visc%Kd_shear(i,j,k) = Z2_T_rescale * visc%Kd_shear(i,j,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j,k) = Z2_T_rescale * visc%Kv_shear(i,j,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) + do k=1,nz+1 ; do J=js-1,je ; do I=is-1,ie + visc%Kv_shear_Bu(I,J,k) = Z2_T_rescale * visc%Kv_shear_Bu(I,J,k) enddo ; enddo ; enddo endif ; endif diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 deleted file mode 100644 index cf0da1c5f3..0000000000 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ /dev/null @@ -1,419 +0,0 @@ -!> Absorption of downwelling shortwave radiation -module MOM_shortwave_abs - -! This file is part of MOM6. See LICENSE.md for the license. - -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_verticalGrid, only : verticalGrid_type - -implicit none ; private - -#include - -public absorbRemainingSW, sumSWoverBands - -!> This type is used to exchange information about ocean optical properties -type, public :: optics_type - ! ocean optical properties - - integer :: nbands !< number of penetrating bands of SW radiation - - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] - !! The number of radiation bands is most rapidly varying (first) index. - - real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. - !! The most rapidly varying dimension is the band. - - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] - -end type optics_type - -contains - -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted -!! from GOLD) or throughout the water column. -!! -!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total -!! water column thickness is greater than H_limit_fluxes. -!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the -!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. -subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, & - adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & - eps, ksort, htot, Ttot, TKE, dSV_dT) - - 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),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< Number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [s]. - real, intent(in) :: H_limit_fluxes !< If the total ocean depth is - !! less than this, they are scaled away - !! to avoid numerical instabilities - !! [H ~> m or kg m-2]. This would - !! not be necessary if a finite heat - !! capacity mud-layer were added. - logical, intent(in) :: adjustAbsorptionProfile !< If true, apply - !! heating above the layers in which it - !! should have occurred to get the - !! correct mean depth (and potential - !! energy change) of the shortwave that - !! should be absorbed by each layer. - logical, intent(in) :: absorbAllSW !< If true, apply heating above the - !! layers in which it should have occurred - !! to get the correct mean depth (and - !! potential energy change) of the - !! shortwave that should be absorbed by - !! each layer. - real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative - !! temperatures [degC] - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in - !! each band that hits the bottom and will - !! will be redistributed through the water - !! column [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in - !! each layer, and which will not be - !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. - real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer - !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [m3 kg-1 degC-1]. - real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer [J m-2]. - ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & - T_chg_above ! A temperature change that will be applied to all the thick - ! layers above a given layer [degC]. This is only nonzero if - ! adjustAbsorptionProfile is true, in which case the net - ! change in the temperature of a layer is the sum of the - ! direct heating of that layer plus T_chg_above from all of - ! the layers below, plus any contribution from absorbing - ! radiation that hits the bottom. - real, dimension(SZI_(G)) :: & - h_heat, & ! The thickness of the water column that will be heated by - ! any remaining shortwave radiation [H ~> m or kg m-2]. - T_chg, & ! The temperature change of thick layers due to the remaining - ! shortwave radiation and contributions from T_chg_above [degC]. - Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave - ! heating that hits the bottom and will be redistributed through - ! the water column [degC H ~> degC m or degC kg m-2] - 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 - 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] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - real :: heat_bnd ! heating due to absorption in the current - ! layer by the current band, including any piece that - ! is moved upward [degC H ~> degC m or degC kg m-2] - real :: SWa ! fraction of the absorbed shortwave that is - ! moved to layers above with adjustAbsorptionProfile [nondim] - real :: coSWa_frac ! The fraction of SWa that is actually moved upward. - real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply - ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. - ! The default, 2.5e-11, is about 0.08 degC m / century. - real :: epsilon ! A small thickness that must remain in each - ! layer, and which will not be subject to heating [H ~> m or kg m-2] - real :: I_G_Earth - real :: g_Hconv2 - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - logical :: TKE_calc ! If true, calculate the implications to the - ! TKE budget of the shortwave heating. - real :: C1_6, C1_60 - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - min_SW_heating = 2.5e-11 - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 - - TKE_calc = (present(TKE) .and. present(dSV_dT)) - g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 - - h_heat(:) = 0.0 - if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do ks=1,nz ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) - - T_chg_above(i,k) = 0.0 - - if (h(i,k) > 1.5*epsilon) 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) * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - ! ###Make these numbers into parameters! - if (nsw*Pen_SW_bnd(n,i)*SW_trans < & - dt*min_SW_heating*min(GV%m_to_H,1e3*h(i,k)) ) SW_trans = 0.0 - - Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) - if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then - ! In this case, a fraction of the heating is applied to the - ! overlying water so that the mean pressure at which the shortwave - ! heating occurs is exactly what it would have been with a careful - ! pressure-weighted averaging of the exponential heating profile, - ! hence there should be no TKE budget requirements due to this - ! layer. Very clever, but this is also limited so that the - ! water above is not heated at a faster rate than the layer - ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) - ! and takes the energetics of the rest of the heating into account. - ! (-RWH, ~7 years later.) - if (opt_depth > 1e-5) then - SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & - ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & - (1.0 - exp_OD)) - else - ! Use Taylor series expansion of the expression above for a - ! more accurate form with very small layer optical depths. - SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & - ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) - endif - coSWa_frac = 0.0 - if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then - coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & - (SWa*(h_heat(i) + h(i,k))) - SWa = h_heat(i) / (h_heat(i) + h(i,k)) - endif - - T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) - T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) - else - coSWa_frac = 1.0 - T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) - endif - - if (TKE_calc) then - if (opt_depth > 1e-2) then - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) - else - ! Use Taylor series-derived approximation to the above expression - ! that is well behaved and more accurate when opt_depth is small. - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) - endif - endif - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - endif ; enddo - endif - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ; enddo ! i & k loops - - -! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return - - ! Unless modified, there is no temperature change due to fluxes from the bottom. - do i=is,ie ; T_chg(i) = 0.0 ; enddo - - if (absorbAllSW) then - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit >= 1.0) then - T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 - else - T_chg(i) = Pen_SW_rem(i) * Ih_limit - unabsorbed = 1.0 - h_heat(i)*Ih_limit - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - endif ! absorbAllSW - - if (absorbAllSW .or. adjustAbsorptionProfile) then - do ks=nz,1,-1 ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - - if (T_chg(i) > 0.0) then - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) - elseif (h(i,k) > h_min_heat) then - T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) - endif - endif - ! Increase the heating for layers above. - T_chg(i) = T_chg(i) + T_chg_above(i,k) - enddo ; enddo - if (present(htot) .and. present(Ttot)) then - do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo - endif - endif ! absorbAllSW .or. adjustAbsorptionProfile - -end subroutine absorbRemainingSW - - -subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & - H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) -!< 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 updat e the state. - 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),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of - !! penetrating shortwave radiation [m-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [s]. - real, intent(in) :: H_limit_fluxes !< the total depth at which the - !! surface fluxes start to be limited to avoid - !! excessive heating of a thin ocean [H ~> m or kg m-2] - logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave - !! radiation is absorbed in the ocean water column. - real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave - !! heating in each band that hits the bottom and - !! will be redistributed through the water column - !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(inout) :: netPen !< Net penetrating shortwave heat flux at each - !! interface, summed across all bands - !! [degC H ~> degC m or degC kg m-2]. - ! Local variables - real :: h_heat(SZI_(G)) ! thickness of the water column that receives - ! remaining shortwave radiation [H ~> m or kg m-2]. - real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the - ! penetrating shortwave heating that hits the bottom - ! and will be redistributed through the water column - ! [degC H ~> degC m or degC kg m-2] - - real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd - real :: SW_trans ! fraction of shortwave radiation not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation - ! not absorbed because the layers are too thin. - 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] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - - pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) - do i=is,ie ; h_heat(i) = 0.0 ; enddo - netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do k=1,nz - - do i=is,ie - netPen(i,k+1) = 0. - - 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_m * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*dt) .and. & - (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*2.5e-8)) & - SW_trans = 0.0 - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) - endif ; enddo - endif ! h(i,k) > 0.0 - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ! i loop - enddo ! k loop - - if (absorbAllSW) then - - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit < 1.0) then - unabsorbed = 1.0 - h_heat(i)*Ih_limit - else - unabsorbed = 0.0 - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - - endif ! absorbAllSW - -end subroutine sumSWoverBands - -end module MOM_shortwave_abs diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 024c3125e7..fd910697af 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -42,9 +42,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [kg Z3 m-3 T-3 ~> W m-2] Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [kg Z3 m-3 T-3 ~> W m-2] Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [kg Z3 m-3 T-3 ~> W m-2] @@ -54,13 +54,13 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate [W m-3?] real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 s-1 ~> m2 s-1]. + !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [kg Z3 m-3 T-3 ~> W m-2] - N2_bot => NULL(),& !< bottom squared buoyancy frequency [s-2] - N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [s-2] + N2_bot => NULL(),& !< bottom squared buoyancy frequency [T-2 ~> s-2] + N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [T-2 ~> s-2] Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [m] Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient @@ -112,7 +112,7 @@ module MOM_tidal_mixing real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the !! ocean bottom used in Polzin formulation of the - !! vertical scale of decay of tidal dissipation [s-1] + !! vertical scale of decay of tidal dissipation [T-1 ~> s-1] real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale !! of the tidal dissipation profile in Polzin [nondim] real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation @@ -148,7 +148,7 @@ module MOM_tidal_mixing !! [kg Z3 m-3 T-3 ~> W m-2] real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided !! by the bottom stratfication [kg Z3 m-3 T-2 ~> J m-2]. - real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [s-1]. + real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [T-1 ~> s-1]. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [m2]. real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m s-1] @@ -159,6 +159,10 @@ module MOM_tidal_mixing !! TODO: make this E(x,y) only real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + 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. + ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays @@ -189,7 +193,6 @@ module MOM_tidal_mixing end type tidal_mixing_cs !!@{ Coded parmameters for specifying mixing schemes -character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" integer, parameter :: STLAURENT_02 = 1 @@ -214,17 +217,18 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) ! Local variables logical :: read_tideamp + logical :: default_2018_answers 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 character(len=200) :: tidal_energy_file, tideamp_file - real :: utide, hamp, prandtl_tidal + real :: utide, hamp, prandtl_tidal, max_frac_rough real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed - -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. if (associated(CS)) then call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & @@ -259,6 +263,14 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) tidal_mixing_init = CS%int_tide_dissipation if (.not. tidal_mixing_init) return + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", CS%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) + if (CS%int_tide_dissipation) then ! Read in CVMix tidal scheme if CVMix tidal mixing is on @@ -359,7 +371,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) "reference value of the buoyancy frequency at the ocean "//& "bottom in the Polzin formulation for the vertical "//& "scale of decay for the tidal energy dissipation.", & - units="s-1", default=9.61e-4) + units="s-1", default=9.61e-4, scale=US%T_to_s) call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & CS%Polzin_decay_scale_factor, & "When the Polzin decay profile is used, this is a "//& @@ -447,17 +459,27 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & + "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& + "or a negative value for no limitations on roughness.", & + units="nondim", default=0.1) + do j=js,je ; do i=is,ie if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) - ! Restrict rms topo to 10 percent of column depth. - !### Note the hard-coded nondimensional constant, and that this could be simplified. - hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j))) - CS%h2(i,j) = hamp*hamp + ! Restrict rms topo to a fraction (often 10 percent) of the column depth. + if (CS%answers_2018 .and. (max_frac_rough >= 0.0)) then + hamp = min(max_frac_rough*G%bathyT(i,j), sqrt(CS%h2(i,j))) + CS%h2(i,j) = hamp*hamp + else + if (max_frac_rough >= 0.0) & + CS%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, CS%h2(i,j)) + endif utide = CS%tideamp(i,j) - ! Compute the fixed part of internal tidal forcing; units are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. + ! Compute the fixed part of internal tidal forcing. + ! The units here are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * & CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -557,7 +579,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 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%Z_to_m**2) + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -576,11 +598,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') + 'Bottom Buoyancy Frequency', 's-1', conversion=US%s_to_T) 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%Z_to_m**2) + 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', & @@ -600,10 +622,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 'scaled by N2_bot/N2_meanz', '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') + 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz', diag%axesT1, Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2', conversion=US%s_to_T**2) CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & 'Work done by Internal Tide Diapycnal Mixing', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) @@ -619,7 +641,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif endif ! S%use_CVMix_tidal endif @@ -662,14 +684,14 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 T-1 ~> m2 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 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 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, G, GV, US, CS, N2_int, Kd_lay, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & - G, GV, US, CS, N2_lay, Kd_lay, Kd_int, US%s_to_T*Kd_max) + G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) endif endif end subroutine calculate_tidal_mixing @@ -690,10 +712,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables - real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] - real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] + real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] + real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] real, dimension(SZK_(G)+1) :: vert_dep ! vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces [m] real, dimension(SZK_(G)+1) :: SchmittnerSocn @@ -772,13 +794,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-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. enddo endif ! diagnostics if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = Kd_tidal(:) + dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif if (associated(dd%N2_int)) then dd%N2_int(i,j,:) = N2_int(i,:) @@ -874,13 +896,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-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. enddo endif ! diagnostics if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = Kd_tidal(:) + dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif if (associated(dd%N2_int)) then dd%N2_int(i,j,:) = N2_int(i,:) @@ -939,7 +961,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. ! local @@ -959,7 +981,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! 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 [s-2] for WKB scaling + N2_meanz, & ! vertically averaged squared buoyancy frequency [T-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) @@ -971,13 +993,15 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. real :: I_rho0 ! 1 / RHO0 [m3 kg-1] - real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-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) 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 :: 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 [kg Z3 m-3 T-3 ~> W m-2] (BDM) @@ -1013,8 +1037,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & GV%H_subroundoff*GV%H_to_Z) do i=is,ie - CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = US%s_to_T**2 * N2_bot(i) + CS%Nb(i,j) = sqrt(N2_bot(i)) + if (associated(dd%N2_bot)) 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))) @@ -1037,9 +1061,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! Polzin: if ( use_Polzin ) then ! WKB scaling of the vertical coordinate - do i=is,ie ; N2_meanz(i)=0.0 ; enddo + do i=is,ie ; N2_meanz(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + (US%s_to_T**2 * N2_lay(i,k)) * GV%H_to_Z * h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * GV%H_to_Z * h(i,j,k) enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) @@ -1050,30 +1074,48 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_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) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler do i=is,ie - CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) - !### In the code below 1.0e-14 is a dimensional constant in [s-3] - if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - 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) * US%T_to_s * CS%Nb(i,j)**3 ) - if (z0_polzin(i) < CS%Polzin_min_decay_scale) & - z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. - z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + CS%Nb(i,j) = sqrt(N2_bot(i)) + if (CS%answers_2018) 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 * & + 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 (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) + else + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(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) else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(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) else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + 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 + + 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) + else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(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) + endif endif if (associated(dd%Polzin_decay_scale)) & @@ -1082,33 +1124,48 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) - if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (CS%answers_2018) 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 endif - endif - if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + 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 endif - endif - if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + 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 + 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 + 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 + 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 endif endif z_from_bot(i) = GV%H_to_Z*h(i,j,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * (US%s_to_T**2 * N2_lay(i,nz)) / N2_meanz(i) - else ; z_from_bot_WKB(i) = 0 ; endif + if (CS%answers_2018) 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) + 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) + else ; z_from_bot_WKB(i) = 0 ; endif + endif enddo endif ! Polzin @@ -1116,7 +1173,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! 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)*US%T_to_s*CS%Nb(i,j), CS%TKE_itide_max) + TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) if (associated(dd%TKE_itidal_used)) & 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) @@ -1178,21 +1235,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_add endif ! diagnostics if (associated(dd%Kd_itidal)) then ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k 1.0e-14 ) then + if (N2_meanz(i) > 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) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) + + GV%H_to_Z * h(i,j,k) * N2_lay(i,k) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer @@ -1266,21 +1323,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_add endif ! diagnostics if (associated(dd%Kd_itidal)) then ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k m or kg m-2]. 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 !< The mixed layer vertical viscosity [Z2 s-1 ~> m2 s-1]. - real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. + real :: Kvml !< The mixed layer vertical viscosity [Z2 T-1 ~> m2 s-1]. + 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 :: Kvbbl !< The vertical viscosity in the bottom boundary - !! layer [Z2 s-1 ~> m2 s-1]. + !! layer [Z2 T-1 ~> m2 s-1]. - real :: maxvel !< Velocity components greater than maxvel are truncated [m s-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 [m s-1]. + !! are set to 0 [L T-1 ~> m s-1]. logical :: CFL_based_trunc !< If true, base truncations on CFL numbers, not !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they @@ -65,17 +65,17 @@ 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 s-1 ~> m s-1]. + a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-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 s-1 ~> m s-1]. + a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-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 s-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under - !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [Z T-1 ~> m s-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 @@ -148,9 +148,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: 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] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -162,9 +162,11 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation terms type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: taux_bot !< Zonal bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to rock [kg Z s-2 m-2 ~> Pa] + optional, intent(out) :: tauy_bot !< Meridional bottom stress from ocean to + !! rock [kg L Z T-2 m-3 ~> Pa] type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave/Stokes information @@ -177,25 +179,26 @@ 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_(G)) ! 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_(G)) ! Ray is the Rayleigh-drag velocity [Z s-1 ~> m s-1]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-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 ! is applied with direct_stress [H ~> m or kg m-2]. real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the time step [s-1]. - real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. + real :: dt_in_T ! The timestep [T ~> s] + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. + real :: dt_Rho0 ! The time step divided by the mean density [L s2 H m T-1 kg-1 ~> s m3 kg-1 or s]. real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness - [s H Z-1 ~> s or s kg m-3]. + ! 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]. real :: stress ! The surface stress times the time step, divided - ! by the density [m2 s-1]. + ! by the density [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: zDS, hfr, h_a ! Temporary variables used with direct_stress. real :: surface_stress(SZIB_(G))! The same as stress, unless the wind stress - ! stress is applied as a body force [m2 s-1]. + ! stress is applied as a body force [H L T-1 ~> m2 s-1 or kg m-1 s-1]. logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -211,11 +214,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix endif - dt_Rho0 = dt/GV%H_to_kg_m2 - dt_Z_to_H = dt*GV%Z_to_H + dt_in_T = US%s_to_T*dt + dt_Rho0 = US%m_s_to_L_T*US%T_to_s * dt_in_T / GV%H_to_kg_m2 + dt_Z_to_H = dt_in_T*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff - Idt = 1.0 / dt + Idt = 1.0 / dt_in_T !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. @@ -239,7 +243,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) + Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) + US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq @@ -318,7 +322,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then @@ -332,7 +336,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) u(I,j,k) = u(I,j,k) - Waves%Us_x(I,j,k) + if (do_i(I)) u(I,j,k) = u(I,j,k) - US%m_s_to_L_T*Waves%Us_x(I,j,k) enddo ; enddo ; endif enddo ! end u-component j loop @@ -347,7 +351,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift add before calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,j,k) = v(i,j,k) + Waves%Us_y(i,j,k) + if (do_i(i)) v(i,j,k) = v(i,j,k) + US%m_s_to_L_T*Waves%Us_y(i,j,k) enddo ; enddo ; endif if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie @@ -385,7 +389,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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)) + 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)) 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) @@ -399,7 +403,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -Rho0*US%L_T2_to_m_s2*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then @@ -413,7 +417,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! When mixing down Eulerian current + Stokes drift subtract after calling solver if (DoStokesMixing) then ; do k=1,nz ; do i=is,ie - if (do_i(i)) v(i,J,k) = v(i,J,k) - Waves%Us_y(i,J,k) + if (do_i(i)) v(i,J,k) = v(i,J,k) - US%m_s_to_L_T*Waves%Us_y(i,J,k) enddo ; enddo ; endif enddo ! end of v-component J loop @@ -455,7 +459,7 @@ end subroutine vertvisc !! after a time-step of viscosity, and the fraction of a time-step's !! worth of barotropic acceleration that a layer experiences after !! viscosity is applied. -subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) +subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag @@ -468,6 +472,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) !! barotopic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables @@ -475,10 +480,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, 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_(G)) ! 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_(G)) ! Ray is the Rayleigh-drag velocity times the time step [m]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-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 [s H Z-1 ~> s or s kg m-3]. + ! 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 @@ -488,7 +493,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_Z_to_H = dt*GV%Z_to_H + dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -542,7 +547,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) 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)) + 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)) 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) @@ -567,9 +572,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) 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),SZJ_(G),SZK_(GV)), & - intent(in) :: u !< Zonal velocity [m s-1] + intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< Meridional velocity [m s-1] + 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] type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces @@ -592,14 +597,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) 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]. real, dimension(SZIB_(G),SZK_(G)+1) :: & - a_cpl, & ! The drag coefficients across interfaces [Z s-1 ~> m s-1]. a_cpl times + a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves [Z s-1 ~> m s-1]. + ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. + 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]. I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. @@ -613,8 +618,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) 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 s-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 s-1 ~> m2 s-1]. + 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 :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior. @@ -676,7 +681,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%bottomdraglaw) then ; do I=Isq,Ieq - kv_bbl(I) = visc%kv_bbl_u(I,j) + kv_bbl(I) = visc%Kv_bbl_u(I,j) bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -843,7 +848,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie - kv_bbl(i) = visc%kv_bbl_v(i,J) + kv_bbl(i) = visc%Kv_bbl_v(i,J) bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -1003,17 +1008,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) enddo ! end of v-point j loop if (CS%debug) then - call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & - CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) - call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m) + call uvchksum("vertvisc_coef h_[uv]", CS%h_u, CS%h_v, G%HI, haloshift=0, scale=GV%H_to_m) + 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) 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) + call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, G%HI, haloshift=0, scale=GV%H_to_m) endif ! Offer diagnostic fields for averaging. - if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) + if (associated(visc%Kv_slow) .and. (CS%id_Kv_slow > 0)) & + call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) @@ -1037,7 +1040,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, 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 s-1 ~> m s-1]. + intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1]. real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] logical, dimension(SZIB_(G)), & @@ -1046,7 +1049,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, 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] - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. 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 @@ -1065,35 +1068,37 @@ 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 s-1 ~> m s-1]. - absf, & ! The average of the neighboring absolute values of f [s-1]. + u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]. + 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]. nk_visc, & ! The (real) interface index of the base of mixed layer. 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 s-1 ~> m2 s-1]. + kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. tbl_thick - real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add [Z2 s-1 ~> m2 s-1]. + 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]. real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. - real :: visc_ml ! The mixed layer viscosity [Z2 s-1 ~> m2 s-1]. + 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 :: a_ml ! The layer coupling coefficient across an interface in - ! the mixed layer [m s-1]. - real :: I_amax ! The inverse of the maximum coupling coefficient [Z-1 ~> m-1].??? + ! the mixed layer [Z T-1 ~> m s-1]. + real :: I_amax ! The inverse of the maximum coupling coefficient [T s-1 Z-1 ~> m-1].??? real :: temp1 ! A temporary variable [H Z ~> m2 or kg 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 :: z2 ! A copy of z_i, nondim. - real :: topfn - real :: a_top + real :: z2 ! A copy of z_i [nondim] + real :: topfn ! A function that is 1 at the top and small far from it [nondim] + real :: a_top ! A viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] logical :: do_shelf, do_OBCs integer :: i, k, is, ie, max_nk integer :: nz real :: botfn a_cpl(:,:) = 0.0 + Kv_tot(:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1103,7 +1108,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The maximum coupling coefficent 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*US%Z_to_m) * dt*US%s_to_T do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1112,15 +1117,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The following loop calculates the vertical average velocity and ! surface mixed layer contributions to the vertical viscosity. - do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo + do i=is,ie ; Kv_tot(i,1) = 0.0 ; enddo if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv + if (do_i(i)) Kv_tot(i,K) = CS%Kv enddo ; enddo ; else I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & + Kv_tot(i,K) = CS%Kv + CS%Kvml / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif @@ -1129,51 +1134,48 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) else - a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl) + a_cpl(i,nz+1) = CS%Kvbbl / (0.5*hvel(i,nz)*GV%H_to_Z + I_amax*CS%Kvbbl) endif endif ; enddo if (associated(visc%Kv_shear)) then - ! BGR/ Add factor of 2. * the averaged Kv_shear. - ! this is needed to reproduce the analytical solution to - ! a simple diffusion problem, likely due to h_shear being - ! equal to 2 x \delta z + ! The factor of 2 that used to be required in the viscosities is no longer needed. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; 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 - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; 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 - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1181,11 +1183,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*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 - a_cpl(i,K) = a_cpl(i,K) + (2.*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 @@ -1197,39 +1199,39 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn - r = (hvel(i,k)+hvel(i,k-1)) - if (r > 2.0*bbl_thick(i)) then - h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) + Kv_tot(i,K) = Kv_tot(i,K) + (kv_bbl(i) - CS%Kv)*botfn + r = 0.5*(hvel(i,k) + hvel(i,k-1)) + if (r > bbl_thick(i)) then + h_shear = ((1.0 - botfn) * r + botfn*bbl_thick(i)) else h_shear = r endif else - a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn - h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect + Kv_tot(i,K) = Kv_tot(i,K) + (CS%Kvbbl-CS%Kv)*botfn + h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) endif - ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1. - a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) + ! 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)) endif ; enddo ; enddo ! i & k loops if (do_shelf) then ! Set the coefficients to include the no-slip surface stress. do i=is,ie ; if (do_i(i)) then if (work_on_u) then - kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) + kv_TBL(i) = visc%Kv_tbl_shelf_u(I,j) tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else - kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) + kv_TBL(i) = visc%Kv_tbl_shelf_v(i,J) tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H 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)*GV%H_to_Z + I_amax*kv_TBL(i)) else - a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i)) + a_cpl(i,1) = kv_TBL(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_TBL(i)) endif endif ; enddo @@ -1237,14 +1239,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, z_t(i) = z_t(i) + hvel(i,k-1) / tbl_thick(i) topfn = 1.0 / (1.0 + 0.09 * z_t(i)**6) - r = (hvel(i,k)+hvel(i,k-1)) - if (r > 2.0*tbl_thick(i)) then - h_shear = ((1.0 - topfn) * r + topfn*2.0*tbl_thick(i)) + r = 0.5*(hvel(i,k)+hvel(i,k-1)) + if (r > tbl_thick(i)) then + h_shear = ((1.0 - topfn) * r + topfn*tbl_thick(i)) else h_shear = r endif - a_top = 2.0 * topfn * kv_tbl(i) + a_top = topfn * kv_TBL(i) a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then @@ -1253,11 +1255,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf(I) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif h_ml(i) = h_neglect ; z_t(i) = 0.0 @@ -1294,10 +1296,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z ! 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. - visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / & - (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + & - 2.0*I_amax* visc_ml) + visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / (absf(i)*temp1 + h_ml(i)*u_star(i)) + 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) ! Choose the largest estimate of a. if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo @@ -1313,9 +1313,9 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS 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),SZJ_(G),SZK_(GV)), & - intent(inout) :: u !< Zonal velocity [m s-1] + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: v !< Meridional velocity [m s-1] + intent(inout) :: 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] type(accel_diag_ptrs), intent(in) :: ADp !< Acceleration diagnostic pointers @@ -1328,13 +1328,14 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both [m s-1]. + real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: CFL ! The local CFL number. real :: H_report ! A thickness below which not to report truncations. real :: dt_Rho0 ! The timestep divided by the Boussinesq density [s m3 kg-1]. - real :: vel_report(SZIB_(G),SZJB_(G)) - real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) - real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) + real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] + real :: u_old(SZIB_(G),SZJ_(G),SZK_(G)) ! The previous u-velocity [L T-1 ~> m s-1] + real :: v_old(SZI_(G),SZJB_(G),SZK_(G)) ! The previous v-velocity [L T-1 ~> m s-1] logical :: trunc_any, dowrite(SZIB_(G),SZJB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -1343,6 +1344,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS maxvel = CS%maxvel truncvel = 0.9*maxvel H_report = 6.0 * GV%Angstrom_H + dt_in_T = US%s_to_T*dt dt_Rho0 = dt / GV%Rho0 if (len_trim(CS%u_trunc_file) > 0) then @@ -1351,13 +1353,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do I=Isq,Ieq ; dowrite(I,j) = .false. ; enddo if (CS%CFL_based_trunc) then - do I=Isq,Ieq ; vel_report(i,j) = 3.0e8 ; enddo ! Speed of light default. + do I=Isq,Ieq ; vel_report(i,j) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) u(I,j,k) = 0.0 if (u(I,j,k) < 0.0) then - CFL = (-u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) + CFL = (-u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i+1,j)) else - CFL = (u(I,j,k) * dt) * (G%dy_Cu(I,j) * G%IareaT(i,j)) + CFL = (u(I,j,k) * dt_in_T) * (G%dy_Cu(I,j) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1381,11 +1383,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz ; do I=Isq,Ieq - if ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + if ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1401,11 +1403,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) 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 - u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then + u(I,j,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i+1,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then - u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dy_Cu(I,j))) + elseif ((u(I,j,k) * (dt_in_T * G%dy_Cu(I,j))) * G%IareaT(i,j) > CS%CFL_trunc) then + u(I,j,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dy_Cu(I,j))) if (h(i,j,k) + h(i+1,j,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1436,13 +1438,13 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS trunc_any = .false. do i=is,ie ; dowrite(i,J) = .false. ; enddo if (CS%CFL_based_trunc) then - do i=is,ie ; vel_report(i,J) = 3.0e8 ; enddo ! Speed of light default. + do i=is,ie ; vel_report(i,J) = 3.0e8*US%m_s_to_L_T ; enddo ! Speed of light default. do k=1,nz ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) v(i,J,k) = 0.0 if (v(i,J,k) < 0.0) then - CFL = (-v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) + CFL = (-v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j+1)) else - CFL = (v(i,J,k) * dt) * (G%dx_Cv(i,J) * G%IareaT(i,j)) + CFL = (v(i,J,k) * dt_in_T) * (G%dx_Cv(i,J) * G%IareaT(i,j)) endif if (CFL > CS%CFL_trunc) trunc_any = .true. if (CFL > CS%CFL_report) then @@ -1466,11 +1468,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS if (trunc_any) then ; if (CS%CFL_based_trunc) then do k=1,nz; do i=is,ie - if ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + if ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo @@ -1486,11 +1488,11 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS !$OMP parallel do default(shared) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie if (abs(v(i,J,k)) < CS%vel_underflow) then ; v(i,J,k) = 0.0 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then - v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j+1) < -CS%CFL_trunc) then + v(i,J,k) = (-0.9*CS%CFL_trunc) * (G%areaT(i,j+1) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 - elseif ((v(i,J,k) * (dt * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then - v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt * G%dx_Cv(i,J))) + elseif ((v(i,J,k) * (dt_in_T * G%dx_Cv(i,J))) * G%IareaT(i,j) > CS%CFL_trunc) then + v(i,J,k) = (0.9*CS%CFL_trunc) * (G%areaT(i,j) / (dt_in_T * G%dx_Cv(i,J))) if (h(i,j,k) + h(i,j+1,k) > H_report) CS%ntrunc = CS%ntrunc + 1 endif enddo ; enddo ; enddo @@ -1624,18 +1626,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 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", fail_if_missing=.true., scale=US%m_to_Z**2, unscaled=Kv_dflt) + units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "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.", & - units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. "//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if "//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a "//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& @@ -1644,7 +1646,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) 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) + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & "If true, base truncations on the CFL number, and not an "//& "absolute speed.", default=.true.) @@ -1688,7 +1690,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "A negligibly small velocity magnitude below which velocity "//& "components are set to 0. A reasonable value might be "//& "1e-30 m/s, which is less than an Angstrom divided by "//& - "the age of the universe.", units="m s-1", default=0.0) + "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 @@ -1696,19 +1698,19 @@ 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%Z_to_m**2) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_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%Z_to_m**2) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) 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%Z_to_m**2) + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) 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) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_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) + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_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', thickness_units) @@ -1723,18 +1725,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, & - Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2') + Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%Z_to_m) + conversion=US%L_T2_to_m_s2*US%Z_to_m) if ((len_trim(CS%u_trunc_file) > 0) .or. (len_trim(CS%v_trunc_file) > 0)) & call PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS%PointAccel_CSp) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 7d9ed5f0a4..0268c04f17 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -528,7 +528,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) + mass = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k) stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass enddo ; enddo ; enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 7c25f5711a..d12897038f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -492,7 +492,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! call generic_tracer_source(tv%T,tv%S,rho_dzt,dzt,Hml,G%isd,G%jsd,1,dt,& - G%areaT,get_diag_time_end(CS%diag),& + G%US%L_to_m**2*G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) @@ -594,7 +594,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde tr_ptr => tr_field(:,:,:,1) do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + tr_ptr(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index deeb9529ee..a13eace934 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -22,6 +22,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : extract_member_remapping_CS, build_reconstructions_1d use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -407,15 +408,16 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) end subroutine neutral_diffusion_calc_coeffs !> Update tracer concentration due to neutral diffusion; layer thickness unchanged by this update. -subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) +subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, US, CS) 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_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [m2] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [m2] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at v-points [L2 ~> m2] real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 89f4a6eef4..d553af730d 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -18,7 +18,7 @@ module MOM_offline_aux use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar use MOM_variables, only : vertvisc_type use MOM_forcing_type, only : forcing -use MOM_shortwave_abs, only : optics_type +use MOM_opacity, only : optics_type use MOM_diag_mediator, only : post_data use MOM_forcing_type, only : forcing @@ -63,17 +63,17 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) do k = 1, nz do i=is-1,ie+1 ; do j=js-1,je+1 - h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + h_new(i,j,k) = max(0.0, G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo enddo @@ -189,10 +189,10 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! in a given cell and scale it back if it would deplete a layer do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hvol = h_pre(i,j,k)*G%areaT(i,j) + hvol = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + max(0.0, top_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) if (pos_flux>hvol .and. pos_flux>0.0) then scale_factor = ( hvol )/pos_flux*max_off_cfl @@ -294,7 +294,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i+1,j)) if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & call MOM_error(WARNING,"Column integral of uh does not match after "//& "barotropic redistribution") @@ -364,7 +364,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i,j+1)) if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -409,7 +409,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = hvol(i,j,k)-min_h*G%areaT(i,j) + h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do i=is-1,ie @@ -460,7 +460,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i+1,j)) if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then call MOM_error(WARNING,"Column integral of uh does not match after "//& "upwards redistribution") @@ -506,7 +506,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 - h2d(j,k) = hvol(i,j,k)-min_h*G%areaT(i,j) + h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo do j=js-1,je @@ -558,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*min(G%areaT(i,j),G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H*min(G%US%L_to_m**2*G%areaT(i,j),G%US%L_to_m**2*G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 00b61210fe..bd482e241b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -10,7 +10,7 @@ module MOM_offline_main use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diabatic_aux, only : diabatic_aux_CS +use MOM_diabatic_aux, only : diabatic_aux_CS, set_pen_shortwave use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field @@ -26,14 +26,14 @@ module MOM_offline_main use MOM_offline_aux, only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d use MOM_offline_aux, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic use MOM_offline_aux, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards -use MOM_opacity, only : set_opacity, opacity_CS +use MOM_opacity, only : opacity_CS, optics_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_shortwave_abs, only : optics_type use MOM_time_manager, only : time_type use MOM_tracer_advect, only : tracer_advect_CS, advect_tracer use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_column_fns, call_tracer_stocks use MOM_tracer_registry, only : tracer_registry_type, MOM_tracer_chksum, MOM_tracer_chkinv +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -68,8 +68,12 @@ module MOM_offline_main !< Pointer to a structure containing metrics and related information type(verticalGrid_type), pointer :: GV => NULL() !< Pointer to structure containing information about the vertical grid + type(unit_scale_type), pointer :: US => NULL() + !< structure containing various unit conversion factors type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type + type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() + !< Pointer to the diabatic_aux control structure !> Variables related to reading in fields from online run integer :: start_index !< Timelevel to start @@ -318,7 +322,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%US%L_to_m**2*G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -329,7 +333,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call MOM_tracer_chkinv(debug_msg, G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) @@ -338,7 +342,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -479,7 +483,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -500,7 +504,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) @@ -513,7 +517,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -524,7 +528,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) @@ -545,7 +549,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) @@ -558,7 +562,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -624,8 +628,8 @@ real function remaining_transport_sum(CS, uhtr, vhtr) remaining_transport_sum = 0. do k=1,nz; do j=js,je ; do i=is,ie - uh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) - vh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) + uh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) + vh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) if (ABS(uhtr(I,j,k))>uh_neglect) then remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) endif @@ -718,7 +722,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, CS%G, CS%GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for @@ -913,9 +917,9 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new @@ -930,9 +934,9 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new @@ -1267,13 +1271,14 @@ end subroutine insert_offline_main !> Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input -subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) +subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(offline_transport_CS), pointer :: CS !< Offline control structure type(diabatic_CS), intent(in) :: diabatic_CSp !< The diabatic control structure type(ocean_grid_type), target, intent(in) :: G !< ocean grid structure type(verticalGrid_type), target, intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), target, intent(in) :: US !< A dimensional unit scaling type character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method @@ -1295,6 +1300,9 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) allocate(CS) call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") + ! Determining the internal unit scaling factors for this run. + CS%US => US + ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing = .true.) @@ -1400,7 +1408,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) if (.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy members from other modules - call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics,& + call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics, & + diabatic_aux_CSp=CS%diabatic_aux_CSp, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 201f8aeb6f..7717fcc050 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -1,5 +1,4 @@ -!> This program contains the subroutines that advect tracers -!! along coordinate surfaces. +!> This module contains the subroutines that advect tracers along coordinate surfaces. module MOM_tracer_advect ! This file is part of MOM6. See LICENSE.md for the license. @@ -17,6 +16,7 @@ module MOM_tracer_advect use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_open_boundary, only : OBC_segment_type use MOM_tracer_registry, only : tracer_registry_type, tracer_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -47,18 +47,19 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H m2 ~> m3 or kg] + intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H m2 ~> m3 or kg] + intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -68,25 +69,25 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & !! first in the x- or y-direction. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face - !! [H m2 ~> m3 or kg] + !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - hprev ! cell volume at the end of previous tracer change [H m2 ~> m3 or kg] + hprev ! cell volume at the end of previous tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: & - uhr ! The remaining zonal thickness flux [H m2 ~> m3 or kg] + uhr ! The remaining zonal thickness flux [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: & - vhr ! The remaining meridional thickness fluxes [H m2 ~> m3 or kg] + vhr ! The remaining meridional thickness fluxes [H L2 ~> m3 or kg] real :: uh_neglect(SZIB_(G),SZJ_(G)) ! uh_neglect and vh_neglect are the real :: vh_neglect(SZI_(G),SZJB_(G)) ! magnitude of remaining transports that - ! can be simply discarded [H m2 ~> m3 or kg]. + ! can be simply discarded [H L2 ~> m3 or kg]. - real :: landvolfill ! An arbitrary? nonzero cell volume [H m2 ~> m3 or kg]. + real :: landvolfill ! An arbitrary? nonzero cell volume [H L2 ~> m3 or kg]. real :: Idt ! 1/dt [s-1]. logical :: domore_u(SZJ_(G),SZK_(G)) ! domore__ indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(G)) ! advection to be done in the corresponding @@ -143,10 +144,10 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! calculations on them, even though they are never used. !$OMP do - do k = 1, nz - do j = jsd, jed; do i = IsdB, IedB; uhr(i,j,k) = 0.0; enddo ; enddo - do j = jsdB, jedB; do i = Isd, Ied; vhr(i,j,k) = 0.0; enddo ; enddo - do j = jsd, jed; do i = Isd, Ied; hprev(i,j,k) = 0.0; enddo ; enddo + do k=1,nz + do j=jsd,jed ; do I=IsdB,IedB ; uhr(I,j,k) = 0.0 ; enddo ; enddo + do J=jsdB,jedB ; do i=Isd,Ied ; vhr(i,J,k) = 0.0 ; enddo ; enddo + do j=jsd,jed ; do i=Isd,Ied ; hprev(i,j,k) = 0.0 ; enddo ; enddo domore_k(k)=1 ! Put the remaining (total) thickness fluxes into uhr and vhr. do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo @@ -155,15 +156,15 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & - ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) + do i=is,ie ; do j=js,je + hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & + ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers - hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) - enddo ; enddo + hprev(i,j,k) = hprev(i,j,k) + & + max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) + enddo ; enddo else do i=is,ie ; do j=js,je hprev(i,j,k) = h_prev_opt(i,j,k) @@ -264,11 +265,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv-stencil, jev+stencil, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv-stencil,jev+stencil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -278,11 +279,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv-stencil, iev+stencil, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, CS%useHuynh) + isv, iev, jsv, jev, k, G, GV, US, CS%usePPM, CS%useHuynh) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -325,16 +326,16 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr !< accumulated volume/mass flux through - !! the zonal face [H m2 ~> m3 or kg] + !! the zonal face [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: uh_neglect !< A tiny zonal mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(G)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row @@ -345,6 +346,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -352,18 +354,21 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, dimension(SZI_(G),ntr) :: & slope_x ! The concentration slope per grid point [conc]. real, dimension(SZIB_(G),ntr) :: & - flux_x ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_x ! The tracer flux across a boundary [H L2 conc ~> m3 conc or kg conc]. + real, dimension(SZI_(G),ntr) :: & + T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. + real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real :: uhh(SZIB_(G)) ! The zonal flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -375,7 +380,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 real :: fac1,u_L_in,u_L_out ! terms used for time-stepping OBC reservoirs type(OBC_segment_type), pointer :: segment=>NULL() - integer :: ishift, idir real :: dt ! the inverse of Idt, needed for time-stepping of tracer reservoirs logical :: usePLMslope @@ -420,6 +424,51 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ; enddo endif ! usePLMslope + ! make a copy of the tracers in case values need to be overridden for OBCs + do m = 1,ntr + do i=G%isd,G%ied + T_tmp(i,m) = Tr(m)%t(i,j,k) + enddo + enddo + ! loop through open boundaries and recalculate flux terms + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + 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 + if (associated(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) + else + T_tmp(I+1,m) = 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 + else + T_tmp(I+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do i=segment%HI%IsdB-1,segment%HI%IsdB+1 + Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) + enddo + enddo + + endif + endif + enddo + endif; endif + + ! Calculate the i-direction fluxes of each tracer, using as much ! the minimum of the remaining mass flux (uhr) and the half the mass ! in the cell plus whatever part of its half of the mass flux that @@ -466,7 +515,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & endif ! Implementation of PPM-H3 - Tp = Tr(m)%t(i_up+1,j,k) ; Tc = Tr(m)%t(i_up,j,k) ; Tm = Tr(m)%t(i_up-1,j,k) + Tp = T_tmp(i_up+1,m) ; Tc = T_tmp(i_up,m) ; Tm = T_tmp(i_up-1,m) if (useHuynh) then aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate @@ -508,7 +557,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !aR = Tr(m)%t(i,j,k) + 0.5 * slope_x(i,m) !flux_x(I,m) = uhh(I)*( aR - 0.5 * slope_x(i,m) * CFL(I) ) ! Alternative implementation of PLM - Tc = Tr(m)%t(i,j,k) + Tc = T_tmp(i,m) flux_x(I,m) = uhh(I)*( Tc + 0.5 * slope_x(i,m) * ( 1. - CFL(I) ) ) ! Original implementation of PLM !flux_x(I,m) = uhh(I)*(Tr(m)%t(i,j,k) + slope_x(i,m)*ts2(I)) @@ -521,7 +570,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !aL = Tr(m)%t(i+1,j,k) - 0.5 * slope_x(i+1,m) !flux_x(I,m) = uhh(I)*( aL + 0.5 * slope_x(i+1,m) * CFL(I) ) ! Alternative implementation of PLM - Tc = Tr(m)%t(i+1,j,k) + Tc = T_tmp(i+1,m) flux_x(I,m) = uhh(I)*( Tc - 0.5 * slope_x(i+1,m) * ( 1. - CFL(I) ) ) ! Original implementation of PLM !flux_x(I,m) = uhh(I)*(Tr(m)%t(i+1,j,k) - slope_x(i+1,m)*ts2(I)) @@ -531,10 +580,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & endif ! usePPM if (associated(OBC)) then ; if (OBC%OBC_pe) then - if (OBC%specified_u_BCs_exist_globally) then + if (OBC%specified_u_BCs_exist_globally .or. OBC%open_u_BCs_exist_globally) then do n=1,OBC%number_of_segments segment=>OBC%segment(n) - if (.not. segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle if (segment%is_E_or_W) then if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then @@ -563,25 +611,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & if (segment%is_E_or_W .and. (j >= segment%HI%jsd .and. j<= segment%HI%jed)) then if (segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle - ishift=0 ! ishift+I corresponds to the nearest interior tracer cell index - idir=1 ! idir switches the sign of the flow so that positive is into the reservoir - if (segment%direction == OBC_DIRECTION_W) then - ishift=1 - idir=-1 - endif - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - uhh(I)=uhr(I,j,k) - u_L_in=max(idir*uhh(I)*segment%Tr_InvLscale3_in,0.) - u_L_out=min(idir*uhh(I)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(u_L_in-u_L_out) - segment%tr_Reg%Tr(m)%tres(I,j,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & - dt*(u_L_in*Tr(m)%t(I+ishift,j,k) - & - u_L_out*segment%tr_Reg%Tr(m)%t(I,j,k))) - endif - enddo ! Tracer fluxes are set to prescribed values only for inflows from masked areas. if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & @@ -630,17 +659,18 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,m)*Idt + Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_x)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,m)*Idt + Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + US%L_to_m**2*flux_x(I,m)*Idt endif ; enddo ; endif ! diagnose convergence of flux_x (do not use the Ihnew(i) part of the logic). ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,m) - flux_x(I-1,m)) * & + Idt * G%IareaT(i,j) endif ; enddo endif @@ -653,16 +683,16 @@ end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, useHuynh) + is, ie, js, je, k, G, GV, US, usePPM, useHuynh) 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(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hprev !< cell volume at the end of previous - !! tracer change [H m2 ~> m3 or kg] + !! tracer change [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr !< accumulated volume/mass flux through - !! the meridional face [H m2 ~> m3 or kg] + !! the meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: vh_neglect !< A tiny meridional mass flux that can - !! be neglected [H m2 ~> m3 or kg] + !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJB_(G),SZK_(G)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row @@ -673,6 +703,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer, intent(in) :: js !< The starting tracer j-index to work on integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: usePPM !< If true, use PPM instead of PLM logical, intent(in) :: useHuynh !< If true, use the Huynh scheme !! for PPM interface values @@ -680,18 +711,20 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, dimension(SZI_(G),ntr,SZJ_(G)) :: & slope_y ! The concentration slope per grid point [conc]. real, dimension(SZI_(G),ntr,SZJB_(G)) :: & - flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + flux_y ! The tracer flux across a boundary [H m2 conc ~> m3 conc or kg conc]. + real, dimension(SZI_(G),ntr,SZJB_(G)) :: & + T_tmp ! The copy of the tracer concentration at constant i,k [H m2 conc ~> m3 conc or kg conc]. real :: maxslope ! The maximum concentration slope per grid point ! consistent with monotonicity [conc]. real :: vhh(SZI_(G),SZJB_(G)) ! The meridional flux that occurs during the - ! current iteration [H m2 ~> m3 or kg]. + ! current iteration [H L2 ~> m3 or kg]. real :: hup, hlos ! hup is the upwind volume, hlos is the ! part of that volume that might be lost ! due to advection out the other side of - ! the grid box, both in [H m2 ~> m3 or kg]. + ! the grid box, both in [H L2 ~> m3 or kg]. real, dimension(SZIB_(G)) :: & - hlst, & ! Work variable [H m2 ~> m3 or kg]. - Ihnew, & ! Work variable [H-1 m-2 ~> m-3 or kg-1]. + hlst, & ! Work variable [H L2 ~> m3 or kg]. + Ihnew, & ! Work variable [H-1 L-2 ~> m-3 or kg-1]. CFL ! A nondimensional work variable. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. @@ -703,7 +736,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer :: i, j, j2, m, n, j_up, stencil real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 real :: fac1,v_L_in,v_L_out ! terms used for time-stepping OBC reservoirs - integer :: jshift, jdir real :: dt ! The inverse of Idt, needed for segment reservoir time-stepping type(OBC_segment_type), pointer :: segment=>NULL() logical :: usePLMslope @@ -757,6 +789,52 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo ; enddo ; endif ; enddo ! End of i-, m-, & j- loops. endif ! usePLMslope + + ! make a copy of the tracers in case values need to be overridden for OBCs + + do j=G%jsd,G%jed; do m=1,ntr; do i=G%isd,G%ied + T_tmp(i,m,j) = Tr(m)%t(i,j,k) + enddo ; enddo ; enddo + + ! loop through open boundaries and recalculate flux terms + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + do i=is,ie + 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 + if (associated(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) + else + T_tmp(i,m,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 + else + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do j=segment%HI%JsdB-1,segment%HI%JsdB+1 + Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) + enddo + enddo + endif + endif ! is_N_S + enddo ! i-loop + enddo ! segment loop + endif; endif + ! Calculate the j-direction fluxes of each tracer, using as much ! the minimum of the remaining mass flux (vhr) and the half the mass ! in the cell plus whatever part of its half of the mass flux that @@ -869,7 +947,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif ! usePPM if (associated(OBC)) then ; if (OBC%OBC_pe) then - if (OBC%specified_v_BCs_exist_globally) then + if (OBC%specified_v_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%specified) cycle @@ -894,34 +972,13 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo endif - if (OBC%open_v_BCs_exist_globally) then do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (segment%specified) cycle if (.not. associated(segment%tr_Reg)) cycle - if (segment%is_N_or_S .and. & - (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then - jshift=0 - jdir=1 - if (segment%direction == OBC_DIRECTION_S) then - jshift=1 - jdir=-1 - endif + if (segment%is_N_or_S .and. (J >= segment%HI%JsdB .and. J<= segment%HI%JedB)) then do i=segment%HI%isd,segment%HI%ied - ! update the reservoir tracer concentration implicitly - ! using Backward-Euler timestep - do m=1,ntr - if (associated(segment%tr_Reg%Tr(m)%tres)) then - vhh(i,J)=vhr(i,J,k) - v_L_in=max(jdir*vhh(i,J)*segment%Tr_InvLscale3_in,0.) - v_L_out=min(jdir*vhh(i,J)*segment%Tr_InvLscale3_out,0.) - fac1=1.0+dt*(v_L_in-v_L_out) - segment%tr_Reg%Tr(m)%tres(i,J,k)= (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - dt*v_L_in*Tr(m)%t(i,j+jshift,k) - & - dt*v_L_out*segment%tr_Reg%Tr(m)%t(i,j,k)) - endif - enddo ! Tracer fluxes are set to prescribed values only for inflows from masked areas. 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 @@ -973,25 +1030,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! diagnostics if (associated(Tr(m)%ad_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + US%L_to_m**2*flux_y(i,m,J)*Idt endif ; enddo ; endif if (associated(Tr(m)%ad2d_y)) then ; do i=is,ie ; if (do_i(i)) then - Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt + Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + US%L_to_m**2*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 do i=is,ie ; if (do_i(i)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * G%IareaT(i,j) + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & + G%IareaT(i,j) endif ; enddo endif - enddo endif ; enddo ! End of j-loop. - end subroutine advect_y !> Initialize lateral tracer advection module @@ -1004,8 +1060,8 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) integer, save :: init_calls = 0 -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_tracer_advect" ! This module's name. character(len=256) :: mesg ! Message for error messages. diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 261d8d1315..098a647ec8 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -23,6 +23,7 @@ module MOM_tracer_hor_diff use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_neutral_diffusion, only : neutral_diffusion_calc_coeffs, neutral_diffusion use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -94,7 +95,7 @@ module MOM_tracer_hor_diff !! using the diffusivity in CS%KhTr, or using space-dependent diffusivity. !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. -subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) +subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -102,6 +103,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla type(MEKE_type), pointer :: MEKE !< MEKE type type(VarMix_CS), pointer :: VarMix !< Variable mixing type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -123,25 +125,25 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a - ! grid cell [H-1 m-2 ~> m-3 or kg-1]. - Kh_h, & ! The tracer diffusivity averaged to tracer points [m2 s-1]. + ! grid cell [H-1 L-2 ~> m-3 or kg-1]. + Kh_h, & ! The tracer diffusivity averaged to tracer points [L2 T-1 ~> m2 s-1]. CFL, & ! A diffusive CFL number for each cell [nondim]. dTr ! The change in a tracer's concentration, in units of concentration [Conc]. real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2 ~> m2]. Coef_x, & ! The coefficients relating zonal tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_u ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_u ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by - ! the distance between adjacent tracer points [m2]. + ! the distance between adjacent tracer points [L2]. Coef_y, & ! The coefficients relating meridional tracer differences - ! to time-integrated fluxes [H m2 ~> m3 or kg]. - Kh_v ! Tracer mixing coefficient at u-points [m2 s-1]. + ! to time-integrated fluxes [H L2 ~> m3 or kg]. + Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. - real :: khdt_max ! The local limiting value of khdt_x or khdt_y [m2]. + real :: khdt_max ! The local limiting value of khdt_x or khdt_y [L2 ~> m2]. real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: S_idx, T_idx ! Indices for temperature and salinity if needed @@ -152,7 +154,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla real :: Idt ! The inverse of the time step [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 :: Kh_loc ! The local value of Kh [m2 s-1]. + real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. + real :: dt_in_T ! The timestep [T ~> s] real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. @@ -173,6 +176,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla call cpu_clock_begin(id_clock_diffuse) ntr = Reg%ntr + dt_in_T = US%s_to_T*dt Idt = 1.0/dt h_neglect = GV%H_subroundoff @@ -210,14 +214,14 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points - Kh_loc=Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Kh_loc = Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -227,14 +231,14 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Kh_loc = CS%KhTr if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + Kh_loc = Kh_loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) + Kh_loc = Kh_loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity - Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points - Kh_loc=Kh_v(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + Rd_dx = 0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points + Kh_loc = Kh_v(i,J)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min endif @@ -242,48 +246,48 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo elseif (Resoln_scaled) then !$OMP parallel do default(shared) private(Res_fn) do j=js,je ; do I=is-1,ie Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn enddo ; enddo !$OMP parallel do default(shared) private(Res_fn) do J=js-1,je ; do i=is,ie Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn enddo ; enddo else ! Use a simple constant diffusivity. if (CS%id_KhTr_u > 0) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo else !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + khdt_x(I,j) = dt_in_T*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) enddo ; enddo endif if (CS%id_KhTr_v > 0) then !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo else !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + khdt_y(i,J) = dt_in_T*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) enddo ; enddo endif endif ! VarMix @@ -296,7 +300,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (khdt_x(I,j) > khdt_max) then khdt_x(I,j) = khdt_max if (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j)) > 0.0) & - Kh_u(I,j) = khdt_x(I,j) / (dt*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Kh_u(I,j) = khdt_x(I,j) / (dt_in_T*(G%dy_Cu(I,j)*G%IdxCu(I,j))) endif enddo ; enddo else @@ -313,7 +317,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (khdt_y(i,J) > khdt_max) then khdt_y(i,J) = khdt_max if (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J)) > 0.0) & - Kh_v(i,J) = khdt_y(i,J) / (dt*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Kh_v(i,J) = khdt_y(i,J) / (dt_in_T*(G%dx_Cv(i,J)*G%IdyCv(i,J))) endif enddo ; enddo else @@ -328,13 +332,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla else ! .not. do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = read_khdt_x(I,j) + khdt_x(I,j) = US%m_to_L**2*read_khdt_x(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = read_khdt_y(i,J) + khdt_y(i,J) = US%m_to_L**2*read_khdt_y(i,J) enddo ; enddo - call pass_vector(khdt_x,khdt_y,G%Domain) + call pass_vector(khdt_x, khdt_y, G%Domain) endif ! do_online if (CS%check_diffusive_CFL) then @@ -401,7 +405,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (itt>1) then ! Update halos for subsequent iterations call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) endif - call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, CS%neutral_diffusion_CSp) + call neutral_diffusion(G, GV, h, Coef_x, Coef_y, I_numitts*dt, Reg, US, CS%neutral_diffusion_CSp) enddo ! itt else ! following if not using neutral diffusion, but instead along-surface diffusion @@ -445,19 +449,19 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Coef_y(i,J) * (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k)))) enddo ; enddo if (associated(Reg%Tr(m)%df_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + Coef_x(I,j) * & + Reg%Tr(m)%df_x(I,j,k) = Reg%Tr(m)%df_x(I,j,k) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + Coef_y(i,J) * & + Reg%Tr(m)%df_y(i,J,k) = Reg%Tr(m)%df_y(i,J,k) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_x)) then ; do j=js,je ; do I=G%IscB,G%IecB - Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + Coef_x(I,j) * & + Reg%Tr(m)%df2d_x(I,j) = Reg%Tr(m)%df2d_x(I,j) + US%L_to_m**2*Coef_x(I,j) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i+1,j,k))*Idt enddo ; enddo ; endif if (associated(Reg%Tr(m)%df2d_y)) then ; do J=G%JscB,G%JecB ; do i=is,ie - Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + Coef_y(i,J) * & + Reg%Tr(m)%df2d_y(i,J) = Reg%Tr(m)%df2d_y(i,J) + US%L_to_m**2*Coef_y(i,J) * & (Reg%Tr(m)%t(i,j,k) - Reg%Tr(m)%t(i,j+1,k))*Idt enddo ; enddo ; endif do j=js,je ; do i=is,ie @@ -518,10 +522,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (CS%debug) then call uvchksum("After tracer diffusion khdt_[xy]", khdt_x, khdt_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) if (CS%use_neutral_diffusion) then call uvchksum("After tracer diffusion Coef_[xy]", Coef_x, Coef_y, & - G%HI, haloshift=0, symmetric=.true.) + G%HI, haloshift=0, symmetric=.true., scale=US%L_to_m**2) endif endif @@ -544,8 +548,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real, intent(in) :: dt !< time step type(tracer_type), intent(inout) :: Tr(:) !< tracer array integer, intent(in) :: ntr !< number of tracers - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< needs a comment - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< needs a comment + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: khdt_epi_x !< Zonal epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: khdt_epi_y !< Meridional epipycnal diffusivity times + !! a time step and the ratio of the open face width over + !! the distance between adjacent tracer points [L2 ~> m2] type(tracer_hor_diff_CS), intent(inout) :: CS !< module control structure type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic structure integer, intent(in) :: num_itts !< number of iterations (usually=1) @@ -574,7 +582,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & - tr_flux_conv ! The flux convergence of tracers [conc H m2 ~> conc m3 or conc kg] + tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R real, dimension(SZI_(G), SZK_(G), SZJ_(G)) :: & @@ -618,12 +626,12 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] real :: Tr_av_L ! The average tracer concentrations on the left and right real :: Tr_av_R ! sides of a pairing [Conc]. - real :: Tr_flux ! The tracer flux from left to right in a pair [conc H m2 ~> conc m3 or conc kg]. + real :: Tr_flux ! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg]. real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing [conc H m2 ~> conc m3 or conc kg]. + ! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. - real :: vol ! A cell volume or mass [H m2 ~> m3 or kg]. + real :: vol ! A cell volume or mass [H L2 ~> m3 or kg]. logical, dimension(SZK_(G)) :: & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. @@ -1334,7 +1342,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,j,k) - Tr_adj_vert_L(i,j,k)) endif if (deep_wt_Rv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + tr_flux_3d(i,j,k) + tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,j,k) else kRa = k0a_Rv(J)%p(i,k) wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b @@ -1375,9 +1383,10 @@ end subroutine tracer_epipycnal_ML_diff !> Initialize lateral tracer diffusion module -subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) +subroutine tracer_hor_diff_init(Time, G, US, param_file, diag, EOS, CS) type(time_type), target, intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diag_ctrl), target, intent(inout) :: diag !< diagnostic control type(EOS_type), target, intent(in) :: EOS !< Equation of state CS type(param_file_type), intent(in) :: param_file !< parameter file @@ -1401,7 +1410,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "KHTR", CS%KhTr, & "The background along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & "The scaling coefficient for along-isopycnal tracer "//& "diffusivity using a shear-based (Visbeck-like) "//& @@ -1409,10 +1418,10 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_MIN", CS%KhTr_Min, & "The minimum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_MAX", CS%KhTr_Max, & "The maximum along-isopycnal tracer diffusivity.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & "The coefficient that scales deformation radius over "//& "grid-spacing in passivity, where passivity is the ratio "//& @@ -1463,19 +1472,19 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, EOS, CS) CS%id_CFL = -1 CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1') + 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1') - CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time,& - 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', & + 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & + 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & cmor_field_name='diftrelo', & cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2') + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) if (CS%check_diffusive_CFL) then CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& 'Grid CFL number for lateral/neutral tracer diffusion', 'nondim') diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index cbaf18d983..4680c058b4 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -738,7 +738,7 @@ subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do m=1,ntr do k=1,nz ; do j=js,je ; do i=is,ie - tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%areaT(i,j)*G%mask2dT(i,j) + tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)*G%mask2dT(i,j) enddo ; enddo ; enddo total_inv = reproducing_sum(tr_inv, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 4db1e9dacd..12fd1e08a1 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -381,7 +381,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 946a5f981f..e712686521 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -320,7 +320,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 39e250da65..92f8491a49 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -360,7 +360,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d59fddbcba..35975bccb0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -407,7 +407,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 7730b8f12e..09fab89b70 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -384,7 +384,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS if (k>0) then k=min(k,k_max) ! Only insert k or first layer with interface 10 m above bottom CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt / & - ((h_new(i,j,k)+GV%H_subroundoff) * G%areaT(i,j) ) + ((h_new(i,j,k)+GV%H_subroundoff) * G%US%L_to_m**2*G%areaT(i,j) ) elseif (k<0) then h_total=GV%H_subroundoff do k=1, nz @@ -392,7 +392,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS enddo do k=1, nz CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + CS%oil_source_rate*dt/(h_total & - * G%areaT(i,j) ) + * G%US%L_to_m**2*G%areaT(i,j) ) enddo endif enddo @@ -441,7 +441,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index ea3ccb8928..af4c1e9659 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -286,7 +286,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(1) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(1) = stocks(1) + CS%diff(i,j,k) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(1) = GV%H_to_kg_m2 * stocks(1) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 9b36254206..aa9d34c4e1 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -393,7 +393,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) stocks(m) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + (G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) * h(i,j,k)) enddo ; enddo ; enddo stocks(m) = GV%H_to_kg_m2 * stocks(m) enddo diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 31223d5686..055e6af00f 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -38,7 +38,7 @@ module BFB_initialization subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) real, dimension(NKMEM_), intent(out) :: Rlay !< Layer potential density. real, dimension(NKMEM_), intent(out) :: g_prime !< The reduced gravity at - !! each interface [m2 Z-1 s-2 ~> m s-2]. + !! each interface [L2 Z-1 T-2 ~> m s-2]. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state !< Integer that selects the diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 65cf4bc90a..558be86734 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -15,6 +15,7 @@ module BFB_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/) use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -27,7 +28,7 @@ module BFB_surface_forcing 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 [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2] + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -46,7 +47,7 @@ module BFB_surface_forcing contains !> Bouyancy forcing for the boundary-forced-basin (BFB) configuration -subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) +subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, US, CS) type(surface), intent(inout) :: state !< A structure containing fields that !! describe the surface state of the ocean. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any @@ -56,6 +57,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) real, intent(in) :: dt !< The amount of time over which !! the fluxes apply [s] 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(BFB_surface_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! BFB_surface_forcing_init. @@ -66,7 +68,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. + ! restoring buoyancy flux [L2 m3 T-3 kg-1 ~> m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -111,7 +113,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -145,7 +147,7 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, 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 * US%m_to_Z*US%T_to_s*CS%Flux_const) / CS%Rho0 Temp_restore = 0.0 do j=js,je ; do i=is,ie ! Set density_restore to an expression for the surface potential @@ -170,9 +172,10 @@ subroutine BFB_buoyancy_forcing(state, fluxes, day, dt, G, CS) end subroutine BFB_buoyancy_forcing !> Initialization for forcing the boundary-forced-basin (BFB) configuration -subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. 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(diag_ctrl), target, intent(in) :: diag !< A structure that is used to !! regulate diagnostic output. @@ -197,7 +200,7 @@ subroutine BFB_surface_forcing_init(Time, G, 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) + 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, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a9a5be3d42..ddffbab1be 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -471,7 +471,7 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) z = -G%bathyT(i,j) do k = nz,1,-1 z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the center of layer k - S(i,j,k) = 34.0 - 1.0 * (z/G%max_depth) + S(i,j,k) = 34.0 - 1.0 * (z / (G%max_depth)) if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e3685ae16f..7a2a6bfd90 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -267,9 +267,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) real :: tr_0, y1, y2, tr_k, rst, rsb, rc, v_k, lon_im1 real :: D_edge ! The thickness [Z ~> m], of the dense fluid at the ! inner edge of the inflow. - real :: g_prime_tot ! The reduced gravity across all layers [m2 Z-1 s-2 ~> m s-2]. + real :: g_prime_tot ! The reduced gravity across all layers [L2 Z-1 T-2 ~> m s-2]. real :: Def_Rad ! The deformation radius, based on fluid of - ! thickness D_edge, in the same units as lat. + ! thickness D_edge, in the same units as lat [m]. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. @@ -290,9 +290,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) if (.not.associated(OBC)) return - g_prime_tot = (GV%g_Earth/GV%Rho0)*2.0 - Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) - tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%Z_to_H + g_prime_tot = (GV%g_Earth / GV%Rho0)*2.0 + Def_Rad = US%L_to_m*sqrt(D_edge*g_prime_tot) / (1.0e-4*US%T_to_s * 1000.0) + tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*US%m_to_L*Def_Rad) * GV%Z_to_H if (OBC%number_of_segments /= 1) then call MOM_error(WARNING, 'Error in DOME OBC segment setup', .true.) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index cce8b43a71..56ca631022 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -107,13 +107,13 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) else do j=js,je ; do i=is,ie ! 3D setup - ! #### TEST ####### + ! ===== TEST ===== !if (G%geoLonT(i,j)<500.) then ! xtil = 500.*1.0e3/xbar !else ! xtil = G%geoLonT(i,j)*1.0e3/xbar !endif - ! ##### TEST ##### + ! ===== TEST ===== xtil = G%geoLonT(i,j)*1.0e3/xbar diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 73d4a2ea1f..730551ccdb 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -300,7 +300,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) do j=js,je do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(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 @@ -352,7 +352,7 @@ subroutine idealized_hurricane_wind_profile(CS, absf, YY, XX, UOCN, VOCN, Tx, Ty ! Implementing Holland (1980) parameteric wind profile - Radius = SQRT(XX**2.+YY**2.) + Radius = SQRT(XX**2 + YY**2) !/ BGR ! rkm - r converted to km for Holland prof. @@ -493,7 +493,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) !/ BR ! Calculate x position as a function of time. xx = ( t0 - time_type_to_real(day)) * CS%hurr_translation_spd * cos(transdir) - r = sqrt(xx**2.+CS%DY_from_center**2.) + r = sqrt(xx**2 + CS%DY_from_center**2) !/ BR ! rkm - r converted to km for Holland prof. ! used in km due to error, correct implementation should @@ -602,7 +602,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) ! Set the surface friction velocity [m s-1]. ustar is always positive. do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(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 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 7df6390c10..c211341493 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -42,6 +42,9 @@ module Kelvin_initialization real :: F_0 !< Coriolis parameter real :: rho_range !< Density range real :: rho_0 !< Mean density + 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 give + !! rotational symmetry and eliminate apparent bugs. end type Kelvin_OBC_CS ! This include declares and sets the variable "version". @@ -54,7 +57,10 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(Kelvin_OBC_CS), pointer :: CS !< Kelvin wave control structure. type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. - logical :: register_Kelvin_OBC + + ! Local variables + logical :: register_Kelvin_OBC + logical :: default_2018_answers character(len=40) :: mdl = "register_Kelvin_OBC" !< This subroutine's name. character(len=32) :: casename = "Kelvin wave" !< This case's name. character(len=200) :: config @@ -89,6 +95,13 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) CS%coast_offset1 = CS%coast_offset1 * 1.e3 ! Convert to m CS%coast_offset2 = CS%coast_offset2 * 1.e3 ! Convert to m endif + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "KELVIN_WAVE_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use expressions that give rotational "//& + "symmetry and eliminate apparent bugs.", default=default_2018_answers) if (CS%mode /= 0) then call get_param(param_file, mdl, "DENSITY_RANGE", CS%rho_range, & default=2.0, do_not_log=.true.) @@ -207,7 +220,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) omega = 2.0 * PI / (12.42 * 3600.0) ! M2 Tide period val1 = US%m_to_Z * sin(omega * time_sec) else - N0 = sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (US%m_to_Z * CS%H0)) + N0 = US%L_to_m*US%s_to_T * sqrt((CS%rho_range / CS%rho_0) * GV%g_Earth * (US%m_to_Z * CS%H0)) ! Two wavelengths in domain plx = 4.0 * PI / G%len_lon pmz = PI * CS%mode / CS%H0 @@ -241,27 +254,26 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) - val2 = fac * exp(- CS%F_0 * y / cff) + val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * cosa / & - (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & + (0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j)))) ) else ! Not rotated yet segment%eta(I,j) = 0.0 segment%normal_vel_bt(I,j) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(I,j,k) = US%m_s_to_L_T * fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * & cos(omega * time_sec) - segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * & - h(i+1,j,k) * G%dyCu(I,j) + segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) enddo endif endif @@ -272,18 +284,20 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - !### Problem: val2 & cff could be a functions of space, but are not set in this loop. - !### Problem: Is val2 in the numerator or denominator below? - if (CS%mode == 0) then - do k=1,nz - segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 -!### For rotational symmetry, this should be: -! segment%tangential_vel(I,J,k) = val1 * cff * sina / & -! ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& -! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 - enddo + if (CS%answers_2018) then + ! Problem: val2 & cff could be functions of space, but are not set in this loop. + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & + (0.25 * (G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) )) + enddo ; endif + else + cff =sqrt(GV%g_Earth * 0.5 * (G%bathyT(i+1,j) + G%bathyT(i,j))) + val2 = fac * exp(- US%T_to_s*CS%F_0 * US%m_to_L*y / cff) + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & + ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) + + enddo ; endif endif enddo ; enddo endif @@ -297,25 +311,24 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) - val2 = fac * exp(- 0.5 * US%s_to_T * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) + val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) segment%eta(I,j) = val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = val1 * cff * sina / & - (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j))) * val2 + segment%normal_vel_bt(I,j) = US%L_T_to_m_s * (val1 * cff * sina / & + (0.5*(G%bathyT(i+1,j) + G%bathyT(i,j)))) * val2 else ! Not rotated yet segment%eta(i,J) = 0.0 segment%normal_vel_bt(i,J) = 0.0 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%nudged_normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(i,J,k) = fac * lambda / CS%F_0 * & + segment%normal_vel(i,J,k) = US%m_s_to_L_T*fac * lambda / CS%F_0 * & exp(- lambda * y) * cos(PI * CS%mode * (k - 0.5) / nz) * cosa - segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * & - h(i,j+1,k) * G%dxCv(i,J) + segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) enddo endif endif @@ -326,18 +339,19 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = 1000. * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - !### Problem: val2 & cff could be a functions of space, but are not set in this loop. - !### Problem: Is val2 in the numerator or denominator below? - if (CS%mode == 0) then - do k=1,nz - segment%tangential_vel(I,J,k) = val1 * cff * sina / & - (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + & - G%bathyT(i+1,j+1) + G%bathyT(i,j+1))) * val2 -!### This should be: -! segment%tangential_vel(I,J,k) = val1 * cff * sina / & -! ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) +& -! (G%bathyT(i+1,j) + G%bathyT(i,j+1))) ) * val2 - enddo + if (CS%answers_2018) then + ! Problem: val2 & cff could be functions of space, but are not set in this loop. + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = (val2 * (val1 * cff * sina / & + (0.25*(G%bathyT(i+1,j) + G%bathyT(i,j) + G%bathyT(i+1,j+1) + G%bathyT(i,j+1))))) + enddo ; endif + else + cff = sqrt(GV%g_Earth * 0.5 * (G%bathyT(i,j+1) + G%bathyT(i,j))) + val2 = fac * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * US%m_to_L*y / cff) + if (CS%mode == 0) then ; do k=1,nz + segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & + ( 0.25*((G%bathyT(i,j) + G%bathyT(i+1,j+1)) + (G%bathyT(i+1,j) + G%bathyT(i,j+1))) )) + enddo ; endif endif enddo ; enddo endif diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 3ba4f0c376..cbfce62f39 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -20,6 +20,7 @@ module MOM_controlled_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), operator(-) use MOM_time_manager, only : get_date, set_date use MOM_time_manager, only : time_type_to_real, real_to_time +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -78,7 +79,7 @@ module MOM_controlled_forcing !> This subroutine calls any of the other subroutines in this file !! that are needed to specify the current surface forcing fields. subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_precip, & - day_start, dt, G, CS) + day_start, dt, G, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: SST_anom !< The sea surface temperature !! anomalies [degC]. @@ -96,6 +97,7 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec type(time_type), intent(in) :: day_start !< Start time of the fluxes. real, intent(in) :: dt !< Length of time over which these !! fluxes will be applied [s]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ctrl_forcing_CS), pointer :: CS !< A pointer to the control structure !! returned by a previous call to !! ctrl_forcing_init. @@ -146,12 +148,12 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_0(i,j) = CS%heat_0(i,j) + dt_heat_rate * ( & -CS%lam_heat*G%mask2dT(i,j)*SST_anom(i,j) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_0(i,j) = CS%precip_0(i,j) + dt_prec_rate * ( & CS%lam_prec * G%mask2dT(i,j)*(SSS_anom(i,j) / SSS_mean(i,j)) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) virt_heat(i,j) = virt_heat(i,j) + CS%heat_0(i,j) @@ -330,13 +332,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u1) = CS%heat_cyc(i,j,m_u1) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u2) - CS%avg_SST_anom(i,j,m_u1)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u1) = CS%precip_cyc(i,j,m_u1) + dt1_prec_rate * ( & CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u2) - CS%avg_SSS_anom(i,j,m_u1)) / & (0.5*(CS%avg_SSS(i,j,m_u2) + CS%avg_SSS(i,j,m_u1))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif @@ -355,13 +357,13 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec do j=js,je ; do i=is,ie CS%heat_cyc(i,j,m_u2) = CS%heat_cyc(i,j,m_u2) + dt1_heat_rate * ( & -CS%lam_cyc_heat*(CS%avg_SST_anom(i,j,m_u3) - CS%avg_SST_anom(i,j,m_u2)) + & - (G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_heat_x(I-1,j) - flux_heat_x(I,j)) + & (flux_heat_y(i,J-1) - flux_heat_y(i,J))) ) ) CS%precip_cyc(i,j,m_u2) = CS%precip_cyc(i,j,m_u2) + dt1_prec_rate * ( & CS%lam_cyc_prec * (CS%avg_SSS_anom(i,j,m_u3) - CS%avg_SSS_anom(i,j,m_u2)) / & (0.5*(CS%avg_SSS(i,j,m_u3) + CS%avg_SSS(i,j,m_u2))) + & - (G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & + (US%m_to_L**2*G%IareaT(i,j) * ((flux_prec_x(I-1,j) - flux_prec_x(I,j)) + & (flux_prec_y(i,J-1) - flux_prec_y(i,J))) ) ) enddo ; enddo endif diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ecf373681d..0da6285f37 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -104,7 +104,7 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear [Z2/s ~> m2 s-1] + KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] ! Pointers to auxiliary fields type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. @@ -483,7 +483,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ustar !< Wind friction velocity [Z s-1 ~> m s-1]. + intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. ! Local Variables real :: Top, MidPoint, Bottom, one_cm real :: DecayScale @@ -562,11 +562,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*US%m_to_Z**2)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) !bgr bug-fix missing g + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) !bgr bug-fix missing g CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -606,11 +606,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) elseif (PartitionMode==1) then if (CS%StkLevelMode==0) then ! Take the value at the midpoint - CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b))**2/(GV%g_Earth*US%m_to_Z**2)) + CMN_FAC = exp(MidPoint*2.*(2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2/(US%L_to_Z**2*GV%g_Earth)) elseif (CS%StkLevelMode==1) then ! Use a numerical integration and then ! divide by layer thickness - WN = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) + WN = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif endif @@ -683,7 +683,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isc,G%iec do jj = G%jsc, G%jec Top = h(ii,jj,1)*GV%H_to_Z - call get_Langmuir_Number( La, G, GV, US, Top, US%Z_to_m*ustar(ii,jj), ii, jj, & + call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & H(ii,jj,:),Override_MA=.false.,WAVES=CS) CS%La_turb(ii,jj) = La enddo @@ -700,7 +700,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) if (CS%id_La_turb>0) & call post_data(CS%id_La_turb, CS%La_turb, CS%diag) - return + end subroutine Update_Stokes_Drift !> A subroutine to fill the Stokes drift from a NetCDF file @@ -824,7 +824,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) endif NUMBANDS = ID do B = 1,NumBands - CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b))**2 / (GV%g_Earth*US%m_to_Z**2) + CS%WaveNum_Cen(b) = (2.*PI*CS%Freq_Cen(b)*US%T_to_s)**2 / (US%L_to_Z**2*GV%g_Earth) enddo endif @@ -881,7 +881,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m]. logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic @@ -901,7 +901,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & !Local Variables real :: Top, bottom, midpoint real :: Dpt_LASL, ShearDirection, WaveDirection - real :: LA_STKx, LA_STKy, LA_STK + real :: LA_STKx, LA_STKy, LA_STK ! Stokes velocities in [m s-1] logical :: ContinueLoop, USE_MA real, dimension(SZK_(G)) :: US_H, VS_H real, dimension(NumBands) :: StkBand_X, StkBand_Y @@ -971,12 +971,13 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! there is also no good reason to cap it here other then ! to prevent large enhancements in unconstrained parts of ! the curve fit parameterizations. - LA = max(WAVES%La_min, sqrt(US%Z_to_m*ustar / (LA_STK+1.e-10))) + ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. + LA = max(WAVES%La_min, sqrt(US%Z_to_m*US%s_to_T*ustar / (LA_STK+1.e-10))) endif if (Use_MA) then WaveDirection = atan2(LA_STKy, LA_STKx) - LA = LA / sqrt(max(1.e-8,cos( WaveDirection - ShearDirection))) + LA = LA / sqrt(max(1.e-8, cos( WaveDirection - ShearDirection))) endif return @@ -999,7 +1000,7 @@ end subroutine get_Langmuir_Number !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) - real, intent(in) :: ustar !< water-side surface friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: ustar !< water-side surface friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: hbl !< boundary layer depth [Z ~> m]. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1023,7 +1024,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(US%Z_to_m*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) + call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) ! surface Stokes drift UStokes = us_to_u10*u10 ! @@ -1033,7 +1034,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp + fp = 0.877 * GV%mks_g_Earth / tmp ! ! mean frequency fm = fm_into_fp * fp @@ -1068,7 +1069,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(US%Z_to_m*ustar / UStokes_sl) + LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) else UStokes_sl = 0.0 LA=1.e8 @@ -1166,15 +1167,15 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 10. ! ~sqrt(0.2*(GV%g_Earth*US%m_to_Z)*2*pi/0.3) + omega_max = 10. ! ~sqrt(0.2*GV%mks_g_Earth*2*pi/0.3) NOmega = 1000 domega = (omega_max-omega_min)/real(NOmega) ! if (WaveAgePeakFreq) then - omega_peak = (GV%g_Earth*US%m_to_Z) / (WA * u10) + omega_peak = GV%mks_g_Earth / (WA * u10) else - omega_peak = 2. * pi * 0.13 * (GV%g_Earth*US%m_to_Z) / U10 + omega_peak = 2. * pi * 0.13 * GV%mks_g_Earth / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1190,11 +1191,11 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) ! wavespec units = m2s - wavespec = (Ann * (GV%g_Earth*US%m_to_Z)**2 / (omega_peak*omega**4 ) ) * & + wavespec = (Ann * GV%mks_g_Earth**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/(GV%g_Earth*US%m_to_Z)) / (GV%g_Earth*US%m_to_Z) + exp( 2.0 * omega**2 * zpt / GV%mks_g_Earth) / GV%mks_g_Earth UStokes = UStokes + Stokes*domega omega = omega + domega enddo @@ -1204,12 +1205,12 @@ 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, u, v, Waves ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for explicit solver + real, intent(in) :: dt !< Time step of MOM6 [T ~> s] for explicit solver real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1219,7 +1220,7 @@ 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 + real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z T-1 m s-1] real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. integer :: i,j,k @@ -1343,7 +1344,7 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) CT=CT+1 u10a = u10 alpha = min(0.028, 0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2 / GV%g_Earth ! Compute z0rough from ustar guess + z0rough = alpha * (US%m_s_to_L_T*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess z0 = z0sm + z0rough CD = ( vonkar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness u10 = USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ab964b5269..29e049c9b6 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -51,7 +51,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: jet_width ! The width of the zonal-mean jet [km] real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] - real :: y_2 + real :: y_2 ! The y-position relative to the center of the domain [km] real :: half_strat ! The fractional depth where the stratification is centered [nondim] real :: half_depth ! The depth where the stratification is centered [Z ~> m] logical :: just_read ! If true, just read parameters but set nothing. @@ -120,18 +120,22 @@ end subroutine Phillips_initialize_thickness subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. - real :: jet_width, jet_height, x_2, y_2 - real :: velocity_amplitude, pi + real :: jet_width ! The width of the zonal-mean jet [km] + real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m] + real :: x_2 ! The x-position relative to the center of the domain [nondim] + real :: y_2 ! The y-position relative to the center of the domain [km] or [nondim] + real :: velocity_amplitude ! The amplitude of velocity perturbations [L T-1 ~> m s-1] + real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] integer :: i, j, k, is, ie, js, je, nz, m logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. @@ -142,7 +146,7 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & "The magnitude of the initial velocity perturbation.", & - units="m s-1", default=0.001, do_not_log=just_read) + units="m s-1", default=0.001, scale=US%m_s_to_L_T, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -163,12 +167,12 @@ subroutine Phillips_initialize_velocity(u, v, G, GV, US, param_file, just_read_p y_2 = G%geoLatCu(I,j) - G%south_lat - 0.5*G%len_lat ! This uses d/d y_2 atan(y_2 / jet_width) ! u(I,j,k) = u(I,j,k+1) + (1e-3 * jet_height / & -! (jet_width * (1.0 + (y_2 / jet_width)**2))) * & -! (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) +! (US%m_to_L*jet_width * (1.0 + (y_2 / jet_width)**2))) * & +! (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) ! This uses d/d y_2 tanh(y_2 / jet_width) - u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / jet_width) * & + u(I,j,k) = u(I,j,k+1) + (1e-3 * (jet_height / (US%m_to_L*jet_width)) * & (sech(y_2 / jet_width))**2 ) * & - (2.0 * GV%g_prime(K+1) * US%T_to_s / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) + (2.0 * GV%g_prime(K+1) / (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1))) enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index f0000dc03d..d5f2bb608b 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -44,9 +44,8 @@ module RGC_initialization contains -!> Sets up the the inverse restoration time (Idamp), and -! the values towards which the interface heights and an arbitrary -! number of tracers should be restored within each sponge. +!> Sets up the the inverse restoration time, and the values towards which the interface heights, +!! velocities and tracers should be restored within the sponges for the RGC test case. subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -55,8 +54,10 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< u velocity. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< v velocity. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(in) :: v !< Array with the v velocity [L T-1 ~> m s-1] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -67,12 +68,12 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! Local variables real :: T(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for temp real :: S(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for salt - real :: U1(SZIB_(G), SZJ_(G), SZK_(G)) ! A temporary array for u - real :: V1(SZI_(G), SZJB_(G), SZK_(G)) ! A temporary array for v + real :: U1(SZIB_(G),SZJ_(G),SZK_(G)) ! A temporary array for u [L T-1 ~> m s-1] + real :: V1(SZI_(G),SZJB_(G),SZK_(G)) ! A temporary array for v [L T-1 ~> m s-1] real :: RHO(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for RHO real :: tmp(SZI_(G),SZJ_(G)) ! A temporary array for tracers. real :: h(SZI_(G),SZJ_(G),SZK_(G)) ! A temporary array for thickness at h points - real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points, in s-1. + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate at h points [s-1]. real :: TNUDG ! Nudging time scale, days real :: pres(SZI_(G)) ! An array of the reference pressure, in Pa real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! @@ -118,9 +119,9 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - if (associated(CSp)) call MOM_error(FATAL, & + if (associated(CSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated control structure.") - if (associated(ACSp)) call MOM_error(FATAL, & + if (associated(ACSp)) call MOM_error(FATAL, & "RGC_initialize_sponges called with an associated ALE-sponge control structure.") ! Here the inverse damping time, in s-1, is set. Set Idamp to 0 ! @@ -128,61 +129,61 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) ! will automatically set up the sponges only where Idamp is positive! ! and mask2dT is 1. - do i=is,ie; do j=js,je - if (G%geoLonT(i,j) <= lensponge) then - dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 - !damp = 1.0/TNUDG * max(0.0,dummy1) - damp = 0.0 - !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp + do i=is,ie ; do j=js,je + if (G%geoLonT(i,j) <= lensponge) then + dummy1 = -(G%geoLonT(i,j))/lensponge + 1.0 + !damp = 1.0/TNUDG * max(0.0,dummy1) + damp = 0.0 + !write(*,*)'1st, G%geoLonT(i,j), damp',G%geoLonT(i,j), damp - elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then + elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then - ! 1 / day - dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) - damp = (1.0/TNUDG) * max(0.0,dummy1) +! 1 / day + dummy1=(G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) + damp = (1.0/TNUDG) * max(0.0,dummy1) - else ; damp=0.0 - endif + else ; damp=0.0 + endif - ! convert to 1 / seconds - if (G%bathyT(i,j) > min_depth) then - Idamp(i,j) = damp/86400.0 - else ; Idamp(i,j) = 0.0 ; endif - enddo ; enddo +! convert to 1 / seconds + if (G%bathyT(i,j) > min_depth) then + Idamp(i,j) = damp/86400.0 + else ; Idamp(i,j) = 0.0 ; endif + enddo ; enddo - ! 1) Read eta, salt and temp from IC file - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) + ! 1) Read eta, salt and temp from IC file + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) ! GM: get two different files, one with temp and one with salt values ! this is work around to avoid having wrong values near the surface ! because of the FIT_SALINITY option. To get salt values right in the ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & + call get_param(PF, mod, "RGC_SPONGE_FILE", state_file, & "The name of the file with temps., salts. and interfaces to \n"// & " damp toward.", fail_if_missing=.true.) - call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & + call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & "The name of the potential temperature variable in \n"//& "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & + call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & "The name of the salinity variable in \n"//& "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & + call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & "The name of the interface height variable in \n"//& "SPONGE_STATE_FILE.", default="eta") - call get_param(PF, mod, "SPONGE_H_VAR", h_var, & + call get_param(PF, mod, "SPONGE_H_VAR", h_var, & "The name of the layer thickness variable in \n"//& "SPONGE_STATE_FILE.", default="h") - !read temp and eta - filename = trim(inputdir)//trim(state_file) - if (.not.file_exists(filename, G%Domain)) & - call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) - call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) - call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) + !read temp and eta + filename = trim(inputdir)//trim(state_file) + if (.not.file_exists(filename, G%Domain)) & + call MOM_error(FATAL, " RGC_initialize_sponges: Unable to open "//trim(filename)) + call read_data(filename,temp_var,T(:,:,:), domain=G%Domain%mpp_domain) + call read_data(filename,salt_var,S(:,:,:), domain=G%Domain%mpp_domain) - if (use_ALE) then + if (use_ALE) then call read_data(filename,h_var,h(:,:,:), domain=G%Domain%mpp_domain) call pass_var(h, G%domain) @@ -199,37 +200,37 @@ subroutine RGC_initialize_sponges(G, GV, tv, u, v, PF, use_ALE, CSp, ACSp) endif if (sponge_uv) then - U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 - call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) + U1(:,:,:) = 0.0; V1(:,:,:) = 0.0 + call set_up_ALE_sponge_vel_field(U1,V1,G,u,v,ACSp) endif - else ! layer mode + else ! layer mode - !read eta - call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) + !read eta + call read_data(filename,eta_var,eta(:,:,:), domain=G%Domain%mpp_domain) - ! Set the inverse damping rates so that the model will know where to - ! apply the sponges, along with the interface heights. - call initialize_sponge(Idamp, eta, G, PF, CSp, GV) + ! Set the inverse damping rates so that the model will know where to + ! apply the sponges, along with the interface heights. + call initialize_sponge(Idamp, eta, G, PF, CSp, GV) - if ( GV%nkml>0 ) then - ! This call to set_up_sponge_ML_density registers the target values of the - ! mixed layer density, which is used in determining which layers can be - ! inflated without causing static instabilities. - do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo + if ( GV%nkml>0 ) then + ! This call to set_up_sponge_ML_density registers the target values of the + ! mixed layer density, which is used in determining which layers can be + ! inflated without causing static instabilities. + do i=is-1,ie ; pres(i) = tv%P_Ref ; enddo - do j=js,je - call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo + do j=js,je + call calculate_density(T(:,j,1), S(:,j,1), pres, tmp(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo - call set_up_sponge_ML_density(tmp, G, CSp) - endif + call set_up_sponge_ML_density(tmp, G, CSp) + endif - ! Apply sponge in tracer fields - call set_up_sponge_field(T, tv%T, G, nz, CSp) - call set_up_sponge_field(S, tv%S, G, nz, CSp) + ! Apply sponge in tracer fields + call set_up_sponge_field(T, tv%T, G, nz, CSp) + call set_up_sponge_field(S, tv%S, G, nz, CSp) endif diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index a32a2978b7..b991fa95bc 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -163,13 +163,13 @@ end subroutine Rossby_front_initialize_temperature_salinity subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: 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(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: u !< i-component of velocity [m s-1] + intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: v !< j-component of velocity [m s-1] + intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & 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 !< A structure indicating the open file !! to parse for model parameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call @@ -177,11 +177,11 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just real :: y ! Non-dimensional coordinate across channel, 0..pi real :: T_range ! Range of salinities and temperatures over the vertical - real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f + real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 degC-1 ~> m s-1 degC-1] real :: dRho_dT real :: Dml, zi, zc, zm ! Depths [Z ~> m]. real :: f ! The local Coriolis parameter [T-1 ~> s-1] - real :: Ty + real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz logical :: just_read ! If true, just read parameters but set nothing. @@ -205,9 +205,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just 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 ) / ( US%s_to_T * f * GV%Rho0 ) + 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) ) + Ty = US%L_to_m*dTdy( G, T_range, G%geoLatT(i,j) ) zi = 0. do k = 1, nz hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index e24db1bcda..48c4dc229d 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -218,7 +218,7 @@ subroutine SCM_CVMix_tests_wind_forcing(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) = US%m_to_Z * sqrt( mag_tau / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( mag_tau / CS%Rho0 ) enddo ; enddo ; endif end subroutine SCM_CVMix_tests_wind_forcing diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 6d3e46bd73..d8b3ad269b 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -15,6 +15,7 @@ module dumbbell_surface_forcing use MOM_time_manager, only : time_type, operator(+), operator(/), get_time use MOM_tracer_flow_control, only : call_tracer_set_forcing use MOM_tracer_flow_control, only : tracer_flow_control_CS +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface implicit none ; private @@ -27,7 +28,7 @@ module dumbbell_surface_forcing !! state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2] + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] real :: Flux_const !< The restoring rate at the surface [m s-1]. real :: gust_const !< A constant unresolved background gustiness !! that contributes to ustar [Pa]. @@ -64,8 +65,6 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) real :: density_restore ! The potential density that is being restored ! toward [kg m-3]. real :: rhoXcp ! The mean density times the heat capacity [J m-3 degC-1]. - real :: buoy_rest_const ! A constant relating density anomalies to the - ! restoring buoyancy flux [m5 s-3 kg-1]. integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -113,7 +112,7 @@ subroutine dumbbell_buoyancy_forcing(state, fluxes, day, dt, G, CS) enddo ; enddo else ! This is the buoyancy only mode. do j=js,je ; do i=is,ie - ! fluxes%buoy is the buoyancy flux into the ocean [m2 s-3]. A positive + ! fluxes%buoy is the buoyancy flux into the ocean [L2 T-3 ~> m2 s-3]. A positive ! buoyancy flux is of the same sign as heating the ocean. fluxes%buoy(i,j) = 0.0 * G%mask2dT(i,j) enddo ; enddo @@ -177,9 +176,10 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) end subroutine dumbbell_dynamic_forcing !> Reads and sets up the forcing for the dumbbell test case -subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) +subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< The current model time. 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(diag_ctrl), target, intent(in) :: diag !< A structure that is used to !! regulate diagnostic output. @@ -208,7 +208,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, 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) + 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, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 61f8183275..da4751b3fa 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -162,9 +162,9 @@ subroutine dyed_channel_update_flow(OBC, CS, G, Time) jsd = segment%HI%jsd ; jed = segment%HI%jed IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB if (CS%frequency == 0.0) then - flow = CS%zonal_flow + flow = G%US%m_s_to_L_T*CS%zonal_flow else - flow = CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) + flow = G%US%m_s_to_L_T*CS%zonal_flow + CS%tidal_amp * cos(2 * PI * CS%frequency * time_sec) endif do k=1,G%ke do j=jsd,jed ; do I=IsdB,IedB diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index cd80514bea..928c8ae223 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -170,9 +170,9 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) cos_wt = cos(ll*x - omega*time_sec) sin_ky = sin(kk * y) cos_ky = cos(kk * y) - segment%normal_vel_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * & + segment%normal_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * exp(- alpha * y) * cos_wt * & (alpha * sin_ky + kk * cos_ky) -! segment%tangential_vel_bt(I,j) = my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky +! segment%tangential_vel_bt(I,j) = G%US%m_s_to_L_T*my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky ! segment%vorticity_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * sin_ky& ! (ll*ll + kk*kk + alpha*alpha) enddo ; enddo diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 033a8f0e52..4351060fb8 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -63,14 +63,20 @@ end subroutine soliton_initialize_thickness !> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, h, G) - type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m s-1] +subroutine soliton_initialize_velocity(u, v, h, G, US) + type(ocean_grid_type), intent(in) :: G !< Grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness [H ~> m or kg m-2] - - real :: x, y, x0, y0 - real :: val1, val2, val3, val4 + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + real :: x, x0 ! Positions in the same units as geoLonT. + real :: y, y0 ! Positions in the same units as geoLatT. + real :: val1 ! A zonal decay scale in the inverse of the units of geoLonT. + real :: val2 ! An overall velocity amplitude [L T-1 ~> m s-1] + real :: val3 ! A decay factor [nondim] + real :: val4 ! The local velocity amplitude [L T-1 ~> m s-1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -78,7 +84,7 @@ subroutine soliton_initialize_velocity(u, v, h, G) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = 0.771*(val1*val1) + val2 = US%m_s_to_L_T * 0.771*(val1*val1) v(:,:,:) = 0.0 u(:,:,:) = 0.0 diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index f12378c3d9..19aacab72d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -31,7 +31,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. - real :: zonal_flow + real :: zonal_flow ! Inflow speed [L T-1 ~> m s-1] integer :: i, j, k, l integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -41,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & - units="m/s", default=8.57) + units="m/s", default=8.57, scale=G%US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 161ad25c11..67999fff40 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -98,7 +98,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) do j=segment%HI%jsc,segment%HI%jec ; do I=segment%HI%IscB,segment%HI%IecB if (OBC%segnum_u(I,j) /= OBC_NONE) then do k=1,nz - my_area(1,j) = my_area(1,j) + h(I,j,k)*G%dyCu(I,j) + my_area(1,j) = my_area(1,j) + h(I,j,k)*G%US%L_to_m*G%dyCu(I,j) enddo endif enddo ; enddo @@ -110,7 +110,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux/total_area + segment%normal_vel_bt(:,:) = G%US%m_s_to_L_T*my_flux/total_area segment%eta(:,:) = cff enddo ! end segment loop diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index d79e9183bf..64f4f84247 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -42,7 +42,7 @@ subroutine USER_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) !! structure. real, dimension(:), intent(out) :: Rlay !< Layer potential density. real, dimension(:), intent(out) :: g_prime !< The reduced gravity at - !! each interface [m2 Z-1 s-2 ~> m s-2]. + !! each interface [L2 Z-1 T-2 ~> m s-2]. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -106,10 +106,11 @@ subroutine USER_initialize_thickness(h, G, GV, param_file, just_read_params) end subroutine USER_initialize_thickness !> initialize velocities. -subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) +subroutine USER_initialize_velocity(u, v, G, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m s-1] - real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] + real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. @@ -247,7 +248,7 @@ end subroutine write_user_log !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) !! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) !! - G%CoriolisBu - The Coriolis parameter [T-1 ~> s-1]. -!! - GV%g_prime - The reduced gravity at each interface [m2 Z-1 s-2 ~> m s-2]. +!! - GV%g_prime - The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable) [kg m-3]. !! If ENABLE_THERMODYNAMICS is defined: !! - T - Temperature [degC].