diff --git a/.github/actions/testing-setup/action.yml b/.github/actions/testing-setup/action.yml index c47270af0d..1ab96aa3df 100644 --- a/.github/actions/testing-setup/action.yml +++ b/.github/actions/testing-setup/action.yml @@ -33,6 +33,7 @@ runs: echo "::group::Install linux packages" sudo apt-get update sudo apt-get install netcdf-bin libnetcdf-dev libnetcdff-dev mpich libmpich-dev + sudo apt-get install linux-tools-common echo "::endgroup::" - name: Compile FMS library diff --git a/.github/workflows/expression.yml b/.github/workflows/expression.yml index c504e6c15a..020d656aee 100644 --- a/.github/workflows/expression.yml +++ b/.github/workflows/expression.yml @@ -24,4 +24,4 @@ jobs: run: make run.symmetric -k -s - name: Run tests - run: make test.repros test.dims -k -s + run: make test.repro test.dim -k -s diff --git a/.github/workflows/other.yml b/.github/workflows/other.yml index 3406fa9bc8..34239b0b7c 100644 --- a/.github/workflows/other.yml +++ b/.github/workflows/other.yml @@ -24,4 +24,4 @@ jobs: run: make run.symmetric -k -s - name: Run tests - run: make test.openmps test.nans test.restarts -k -s + run: make test.openmp test.nan test.restart -k -s diff --git a/.github/workflows/perfmon.yml b/.github/workflows/perfmon.yml new file mode 100644 index 0000000000..00e645c4fd --- /dev/null +++ b/.github/workflows/perfmon.yml @@ -0,0 +1,36 @@ +name: Performance Monitor + +on: [pull_request] + +jobs: + build-test-perfmon: + + runs-on: ubuntu-latest + defaults: + run: + working-directory: .testing + + steps: + - uses: actions/checkout@v2 + with: + submodules: recursive + + - uses: ./.github/actions/testing-setup + + - name: Compile optimized models + run: >- + make -j build.prof + MOM_TARGET_SLUG=$GITHUB_REPOSITORY + MOM_TARGET_LOCAL_BRANCH=$GITHUB_BASE_REF + DO_REGRESSION_TESTS=true + + - name: Generate profile data + run: >- + pip install f90nml && + make profile + DO_REGRESSION_TESTS=true + + - name: Generate perf data + run: | + sudo sysctl -w kernel.perf_event_paranoid=2 + make perf DO_REGRESSION_TESTS=true diff --git a/.github/workflows/regression.yml b/.github/workflows/regression.yml index 7dd1f3c703..acc42e4720 100644 --- a/.github/workflows/regression.yml +++ b/.github/workflows/regression.yml @@ -24,4 +24,4 @@ jobs: run: make run.symmetric -k -s - name: Regression test - run: make test.regressions DO_REGRESSION_TESTS=true -k -s + run: make test.regression DO_REGRESSION_TESTS=true -k -s diff --git a/.github/workflows/stencil.yml b/.github/workflows/stencil.yml index 20081747cc..51a0611fc4 100644 --- a/.github/workflows/stencil.yml +++ b/.github/workflows/stencil.yml @@ -24,4 +24,4 @@ jobs: run: make run.symmetric -k -s - name: Run tests - run: make test.grids test.layouts test.rotations -k -s + run: make test.grid test.layout test.rotate -k -s diff --git a/.testing/Makefile b/.testing/Makefile index 45d05cd23f..bd0cbc4c0a 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -16,37 +16,43 @@ # These settings can be provided as either command-line flags, or saved in a # `config.mk` file. # -# Test suite configuration: +# Experiment Configuration: +# BUILDS Executables to be built by `make` or `make all` +# CONFIGS Model configurations to test (default: `tc*`) +# TESTS Tests to run +# DIMS Dimensional scaling tests +# (NOTE: Each test will build its required executables, regardless of BUILDS) # +# General test configuration: +# FRAMEWORK Model framework (fms1 or fms2) # MPIRUN MPI job launcher (mpirun, srun, etc) # DO_REPRO_TESTS Enable production ("repro") testing equivalence -# DO_REGRESSION_TESTS: Enable regression tests (usually dev/gfdl) +# DO_REGRESSION_TESTS Enable regression tests (usually dev/gfdl) # REPORT_COVERAGE Enable code coverage and report to codecov # # Compiler configuration: -# (NOTE: These are environment variables and may be inherited from a shell.) -# # CC C compiler # MPICC MPI C compiler # FC Fortran compiler # MPIFC MPI Fortran compiler +# (NOTE: These are environment variables and may be inherited from a shell.) # # Build configuration: # FCFLAGS_DEBUG Testing ("debug") compiler flags # FCFLAGS_REPRO Production ("repro") compiler flags +# FCFLAGS_OPT Aggressive optimization compiler flags # FCFLAGS_INIT Variable initialization flags # FCFLAGS_COVERAGE Code coverage flags # # Regression repository ("target") configuration: -# (NOTE: These would typically be configured by a CI such as Travis.) -# # MOM_TARGET_SLUG URL slug (minus domain) of the target repo # MOM_TARGET_URL Full URL of the target repo # MOM_TARGET_LOCAL_BRANCH Target branch name +# (NOTE: These would typically be configured by a CI.) # #---- -# TODO: Bourne shell compatibility +# TODO: POSIX shell compatibility SHELL = bash # No implicit rules @@ -58,6 +64,9 @@ MAKEFLAGS += -R # User-defined configuration -include config.mk +# Set the infra framework +FRAMEWORK ?= fms1 + # Set the MPI launcher here # TODO: This needs more automated configuration MPIRUN ?= mpirun @@ -72,10 +81,11 @@ export MPIFC # NOTE: FMS will be built using FCFLAGS_DEBUG FCFLAGS_DEBUG ?= -g -O0 FCFLAGS_REPRO ?= -g -O2 +FCFLAGS_OPT ?= -g -O3 -mavx -fno-omit-frame-pointer FCFLAGS_INIT ?= FCFLAGS_COVERAGE ?= # Additional notes: -# - The default values are simple, minimalist flags, supported by nearly all +# - These default values are simple, minimalist flags, supported by nearly all # compilers which are comparable to GFDL's canonical DEBUG and REPRO builds. # # - These flags should be configured outside of the Makefile, either with @@ -96,6 +106,14 @@ DO_REPRO_TESTS ?= # Time measurement (configurable by the CI) TIME ?= time + +# Experiment configuration +BUILDS ?= symmetric asymmetric openmp +CONFIGS ?= $(wildcard tc*) +TESTS ?= grid layout rotate restart openmp nan $(foreach d,$(DIMS),dim.$(d)) +DIMS ?= t l h z q r + + #--- # Dependencies DEPS = deps @@ -108,18 +126,17 @@ MKMF := $(DEPS)/bin/mkmf #--- # Test configuration -# Executables -BUILDS = symmetric asymmetric repro openmp -CONFIGS := $(wildcard tc*) -TESTS = grids layouts restarts nans dims openmps rotations -DIMS = t l h z q r - # REPRO tests enable reproducibility with optimization, and often do not match # the DEBUG results in older GCCs and vendor compilers, so we can optionally # disable them. ifeq ($(DO_REPRO_TESTS), true) BUILDS += repro - TESTS += repros + TESTS += repro +endif + +# Profiling +ifeq ($(DO_PROFILE), false) + BUILDS += opt opt_target endif # The following variables are configured by Travis: @@ -132,7 +149,7 @@ REPORT_COVERAGE ?= ifeq ($(DO_REGRESSION_TESTS), true) BUILDS += target - TESTS += regressions + TESTS += regression MOM_TARGET_SLUG ?= NOAA-GFDL/MOM6 MOM_TARGET_URL ?= https://github.com/$(MOM_TARGET_SLUG) @@ -192,9 +209,10 @@ endif #--- # Rules -.PHONY: all build.regressions +.PHONY: all build.regressions build.prof all: $(foreach b,$(BUILDS),build/$(b)/MOM6) $(VENV_PATH) build.regressions: $(foreach b,symmetric target,build/$(b)/MOM6) +build.prof: $(foreach b,opt opt_target,build/$(b)/MOM6) # Executable BUILD_TARGETS = MOM6 Makefile path_names @@ -217,6 +235,7 @@ PATH_FMS = PATH="${PATH}:../../$(DEPS)/bin" SYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(COVERAGE) $(FCFLAGS_FMS)" ASYMMETRIC_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" REPRO_FCFLAGS := FCFLAGS="$(FCFLAGS_REPRO) $(FCFLAGS_FMS)" +OPT_FCFLAGS := FCFLAGS="$(FCFLAGS_OPT) $(FCFLAGS_FMS)" OPENMP_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" TARGET_FCFLAGS := FCFLAGS="$(FCFLAGS_DEBUG) $(FCFLAGS_INIT) $(FCFLAGS_FMS)" @@ -230,6 +249,8 @@ build/asymmetric/Makefile: MOM_ENV=$(PATH_FMS) $(ASYMMETRIC_FCFLAGS) $(MOM_LDFLA build/repro/Makefile: MOM_ENV=$(PATH_FMS) $(REPRO_FCFLAGS) $(MOM_LDFLAGS) build/openmp/Makefile: MOM_ENV=$(PATH_FMS) $(OPENMP_FCFLAGS) $(MOM_LDFLAGS) build/target/Makefile: MOM_ENV=$(PATH_FMS) $(TARGET_FCFLAGS) $(MOM_LDFLAGS) +build/opt/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) +build/opt_target/Makefile: MOM_ENV=$(PATH_FMS) $(OPT_FCFLAGS) $(MOM_LDFLAGS) build/coupled/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) build/nuopc/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) build/mct/Makefile: MOM_ENV=$(PATH_FMS) $(SYMMETRIC_FCFLAGS) $(SYMMETRIC_LDFLAGS) @@ -240,12 +261,15 @@ build/asymmetric/Makefile: MOM_ACFLAGS=--enable-asymmetric build/repro/Makefile: MOM_ACFLAGS= build/openmp/Makefile: MOM_ACFLAGS=--enable-openmp build/target/Makefile: MOM_ACFLAGS= +build/opt/Makefile: MOM_ACFLAGS= +build/opt_target/Makefile: MOM_ACFLAGS= build/coupled/Makefile: MOM_ACFLAGS=--with-driver=coupled_driver build/nuopc/Makefile: MOM_ACFLAGS=--with-driver=nuopc_driver build/mct/Makefile: MOM_ACFLAGS=--with-driver=mct_driver # Fetch regression target source code build/target/Makefile: | $(TARGET_CODEBASE) +build/opt_target/Makefile: | $(TARGET_CODEBASE) # Define source code dependencies @@ -267,7 +291,7 @@ build/%/MOM6: build/%/Makefile build/%/Makefile: ../ac/configure ../ac/Makefile.in $(DEPS)/lib/libFMS.a $(MKMF) $(LIST_PATHS) mkdir -p $(@D) cd $(@D) \ - && $(MOM_ENV) ../../../ac/configure $(MOM_ACFLAGS) \ + && $(MOM_ENV) ../../../ac/configure $(MOM_ACFLAGS) --with-framework=$(FRAMEWORK) \ || (cat config.log && false) @@ -276,7 +300,8 @@ build/%/Makefile: ../ac/configure ../ac/Makefile.in $(DEPS)/lib/libFMS.a $(MKMF) # Fetch the regression target codebase -build/target/Makefile: $(TARGET_CODEBASE)/ac/configure $(DEPS)/lib/libFMS.a $(MKMF) $(LIST_PATHS) +build/target/Makefile build/opt_target/Makefile: \ + $(TARGET_CODEBASE)/ac/configure $(DEPS)/lib/libFMS.a $(MKMF) $(LIST_PATHS) mkdir -p $(@D) cd $(@D) \ && $(MOM_ENV) ../../$(TARGET_CODEBASE)/ac/configure $(MOM_ACFLAGS) \ @@ -333,6 +358,7 @@ $(DEPS)/Makefile: ../ac/deps/Makefile mkdir -p $(@D) cp $< $@ + #--- # The following block does a non-library build of a coupled driver interface to MOM, along with everything below it. # This simply checks that we have not broken the ability to compile. This is not a means to build a complete coupled executable. @@ -353,6 +379,7 @@ build/mct/mom_ocean_model_mct.o: build/mct/Makefile cd $(@D) && make $(@F) check_mom6_api_mct: build/mct/mom_ocean_model_mct.o + #--- # Python preprocessing @@ -382,22 +409,39 @@ test: $(foreach t,$(TESTS),test.$(t)) # TODO: restart checksum comparison is not yet implemented .PHONY: $(foreach t,$(TESTS),test.$(t)) -test.grids: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(c).grid $(c).grid.diag) -test.layouts: $(foreach c,$(CONFIGS),$(c).layout $(c).layout.diag) -test.rotations: $(foreach c,$(CONFIGS),$(c).rotate) -test.restarts: $(foreach c,$(CONFIGS),$(c).restart) -test.repros: $(foreach c,$(CONFIGS),$(c).repro $(c).repro.diag) -test.openmps: $(foreach c,$(CONFIGS),$(c).openmp $(c).openmp.diag) -test.nans: $(foreach c,$(CONFIGS),$(c).nan $(c).nan.diag) -test.dims: $(foreach c,$(CONFIGS),$(foreach d,$(DIMS),$(c).dim.$(d) $(c).dim.$(d).diag)) -test.regressions: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) +test.grid: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(c).grid $(c).grid.diag) +test.layout: $(foreach c,$(CONFIGS),$(c).layout $(c).layout.diag) +test.rotate: $(foreach c,$(CONFIGS),$(c).rotate) +test.restart: $(foreach c,$(CONFIGS),$(c).restart) +test.repro: $(foreach c,$(CONFIGS),$(c).repro $(c).repro.diag) +test.openmp: $(foreach c,$(CONFIGS),$(c).openmp $(c).openmp.diag) +test.nan: $(foreach c,$(CONFIGS),$(c).nan $(c).nan.diag) +test.regression: $(foreach c,$(CONFIGS),$(c).regression $(c).regression.diag) +test.dim: $(foreach d,$(DIMS),test.dim.$(d)) +define TEST_DIM_RULE +test.dim.$(1): $(foreach c,$(CONFIGS),$(c).dim.$(1) $(c).dim.$(1).diag) +endef +$(foreach d,$(DIMS),$(eval $(call TEST_DIM_RULE,$(d)))) .PHONY: run.symmetric run.asymmetric run.nans run.openmp run.symmetric: $(foreach c,$(CONFIGS),work/$(c)/symmetric/ocean.stats) run.asymmetric: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(CONFIGS),work/$(c)/asymmetric/ocean.stats) -run.nans: $(foreach c,$(CONFIGS),work/$(c)/nan/ocean.stats) +run.nan: $(foreach c,$(CONFIGS),work/$(c)/nan/ocean.stats) run.openmp: $(foreach c,$(CONFIGS),work/$(c)/openmp/ocean.stats) +# Configuration test rules +# $(1): Configuration name (tc1, tc2, &c.) +# $(2): Excluded tests +.PRECIOUS: $(foreach c,$(CONFIGS),$(c)) +define CONFIG_RULE +$(1): \ + $(foreach t,$(filter-out $(2),$(TESTS)),$(1).$(t)) \ + $(foreach t,$(filter-out $(2) rotate restart,$(TESTS)),$(1).$(t).diag) +endef +$(foreach c,$(filter-out tc3,$(CONFIGS)),$(eval $(call CONFIG_RULE,$(c),))) +# NOTE: tc3 uses OBCs and does not support asymmetric grid +$(eval $(call CONFIG_RULE,tc3,grid)) + # Color highlights for test results RED = \033[0;31m YELLOW = \033[0;33m @@ -411,36 +455,41 @@ WARN = ${YELLOW}WARN${RESET} FAIL = ${RED}FAIL${RESET} # Comparison rules -# $(1): Test type (grid, layout, &c.) -# $(2): Comparison targets (symmetric asymmetric, symmetric layout, &c.) +# $(1): Configuration (tc1, tc2, &c.) +# $(2): Test type (grid, layout, &c.) +# $(3): Comparison targets (symmetric asymmetric, symmetric layout, &c.) define CMP_RULE -.PRECIOUS: $(foreach b,$(2),work/%/$(b)/ocean.stats) -%.$(1): $(foreach b,$(2),work/%/$(b)/ocean.stats) - @test "$$(shell ls -A results/$$* 2>/dev/null)" || rm -rf results/$$* +.PRECIOUS: $(foreach b,$(3),work/$(1)/$(b)/ocean.stats) +$(1).$(2): $(foreach b,$(3),work/$(1)/$(b)/ocean.stats) + @test "$$(shell ls -A results/$(1) 2>/dev/null)" || rm -rf results/$(1) @cmp $$^ || !( \ - mkdir -p results/$$*; \ - (diff $$^ | tee results/$$*/ocean.stats.$(1).diff | head -n 20) ; \ - echo -e "$(FAIL): Solutions $$*.$(1) have changed." \ + mkdir -p results/$(1); \ + (diff $$^ | tee results/$(1)/ocean.stats.$(2).diff | head -n 20) ; \ + echo -e "$(FAIL): Solutions $(1).$(2) have changed." \ ) - @echo -e "$(PASS): Solutions $$*.$(1) agree." + @echo -e "$(PASS): Solutions $(1).$(2) agree." -.PRECIOUS: $(foreach b,$(2),work/%/$(b)/chksum_diag) -%.$(1).diag: $(foreach b,$(2),work/%/$(b)/chksum_diag) +.PRECIOUS: $(foreach b,$(3),work/$(1)/$(b)/chksum_diag) +$(1).$(2).diag: $(foreach b,$(3),work/$(1)/$(b)/chksum_diag) @cmp $$^ || !( \ - mkdir -p results/$$*; \ - (diff $$^ | tee results/$$*/chksum_diag.$(1).diff | head -n 20) ; \ - echo -e "$(FAIL): Diagnostics $$*.$(1).diag have changed." \ + mkdir -p results/$(1); \ + (diff $$^ | tee results/$(1)/chksum_diag.$(2).diff | head -n 20) ; \ + echo -e "$(FAIL): Diagnostics $(1).$(2).diag have changed." \ ) - @echo -e "$(PASS): Diagnostics $$*.$(1).diag agree." + @echo -e "$(PASS): Diagnostics $(1).$(2).diag agree." endef -$(eval $(call CMP_RULE,grid,symmetric asymmetric)) -$(eval $(call CMP_RULE,layout,symmetric layout)) -$(eval $(call CMP_RULE,rotate,symmetric rotate)) -$(eval $(call CMP_RULE,repro,symmetric repro)) -$(eval $(call CMP_RULE,openmp,symmetric openmp)) -$(eval $(call CMP_RULE,nan,symmetric nan)) -$(foreach d,$(DIMS),$(eval $(call CMP_RULE,dim.$(d),symmetric dim.$(d)))) +$(foreach c,$(CONFIGS),$(eval $(call CMP_RULE,$(c),grid,symmetric asymmetric))) +$(foreach c,$(CONFIGS),$(eval $(call CMP_RULE,$(c),layout,symmetric layout))) +$(foreach c,$(CONFIGS),$(eval $(call CMP_RULE,$(c),rotate,symmetric rotate))) +$(foreach c,$(CONFIGS),$(eval $(call CMP_RULE,$(c),repro,symmetric repro))) +$(foreach c,$(CONFIGS),$(eval $(call CMP_RULE,$(c),openmp,symmetric openmp))) +$(foreach c,$(CONFIGS),$(eval $(call CMP_RULE,$(c),nan,symmetric nan))) +define CONFIG_DIM_RULE +$(1).dim: $(foreach d,$(DIMS),$(1).dim.$(d)) +$(foreach d,$(DIMS),$(eval $(call CMP_RULE,$(1),dim.$(d),symmetric dim.$(d)))) +endef +$(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # Custom comparison rules @@ -521,9 +570,10 @@ work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) @echo -e "$(DONE): $$*.$(1); no runtime errors." if [ $(3) ]; then \ mkdir -p results/$$* ; \ - bash <(curl -s https://codecov.io/bash) -n $$@ \ - > work/$$*/codecov.$(1).out \ - 2> work/$$*/codecov.$(1).err \ + cd build/symmetric \ + && bash <(curl -s https://codecov.io/bash) -Z -n $$@ \ + > codecov.$$*.$(1).out \ + 2> codecov.$$*.$(1).err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}"; \ fi endef @@ -539,7 +589,7 @@ $(eval $(call STAT_RULE,repro,repro,,,,1)) $(eval $(call STAT_RULE,openmp,openmp,,,GOMP_CPU_AFFINITY=0,1)) $(eval $(call STAT_RULE,layout,symmetric,,LAYOUT=2$(,)1,,2)) $(eval $(call STAT_RULE,rotate,symmetric,,ROTATE_INDEX=True\nINDEX_TURNS=1,,1)) -$(eval $(call STAT_RULE,nan,symmetric,,,MALLOC_PERTURB_=256,1)) +$(eval $(call STAT_RULE,nan,symmetric,,,MALLOC_PERTURB_=1,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)) @@ -548,7 +598,11 @@ $(eval $(call STAT_RULE,dim.q,symmetric,,Q_RESCALE_POWER=11,,1)) $(eval $(call STAT_RULE,dim.r,symmetric,,R_RESCALE_POWER=11,,1)) -# Restart tests require significant preprocessing, and are handled separately. +# Generate the half-period input namelist as follows: +# 1. Fetch DAYMAX and TIMEUNIT from MOM_input +# 2. Convert DAYMAX from TIMEUNIT to seconds +# 3. Apply seconds to `ocean_solo_nml` inside input.nml. +# NOTE: Assumes that runtime set by DAYMAX, will fail if set by input.nml work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) rm -rf $(@D) mkdir -p $(@D) @@ -561,14 +615,13 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) cd work/$*/restart; \ fi mkdir -p $(@D)/RESTART - # Generate the half-period input namelist - # TODO: Assumes that runtime set by DAYMAX, will fail if set by input.nml + # Set the half-period 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}")) \ + && halfperiod=$$(awk -v t=$${daymax} -v dt=$${timeunit} 'BEGIN {printf "%.f", 0.5*t*dt}') \ && printf "\n&ocean_solo_nml\n seconds = $${halfperiod}\n/\n" >> input.nml # Remove any previous archived output rm -f results/$*/std.restart{1,2}.{out,err} @@ -620,11 +673,75 @@ test.summary: fi +#--- +# Profiling +# XXX: This is experimental work to track, log, and report changes in runtime +PCONFIGS = p0 + +.PHONY: profile +profile: $(foreach p,$(PCONFIGS), prof.$(p)) + +.PHONY: prof.p0 +prof.p0: work/p0/opt/clocks.json work/p0/opt_target/clocks.json + python tools/compare_clocks.py $^ + +work/p0/%/clocks.json: work/p0/%/std.out + python tools/parse_fms_clocks.py -d $(@D) $^ > $@ + +work/p0/opt/std.out: build/opt/MOM6 +work/p0/opt_target/std.out: build/opt_target/MOM6 + +work/p0/%/std.out: + mkdir -p $(@D) + cp -RL p0/* $(@D) + mkdir -p $(@D)/RESTART + echo -e "" > $(@D)/MOM_override + cd $(@D) \ + && $(MPIRUN) -n 1 ../../../$< 2> std.err > std.out + +#--- +# Same but with perf + +# TODO: This expects the -e flag, can I handle it in the command? +PERF_EVENTS ?= + +.PHONY: perf +perf: $(foreach p,$(PCONFIGS), perf.$(p)) + +.PHONY: prof.p0 +perf.p0: work/p0/opt/profile.json work/p0/opt_target/profile.json + python tools/compare_perf.py $^ + +work/p0/%/profile.json: work/p0/%/perf.data + python tools/parse_perf.py -f $< > $@ + +work/p0/opt/perf.data: build/opt/MOM6 +work/p0/opt_target/perf.data: build/opt_target/MOM6 + +work/p0/%/perf.data: + mkdir -p $(@D) + cp -RL p0/* $(@D) + mkdir -p $(@D)/RESTART + echo -e "" > $(@D)/MOM_override + cd $(@D) \ + && perf record \ + -F 3999 \ + ${PERF_EVENTS} \ + ../../../$< 2> std.perf.err > std.perf.out \ + || cat std.perf.err + + #---- # NOTE: These tests assert that we are in the .testing directory. .PHONY: clean -clean: clean.stats +clean: clean.build clean.stats + @[ $$(basename $$(pwd)) = .testing ] + rm -rf deps + + +.PHONY: clean.build +clean.build: @[ $$(basename $$(pwd)) = .testing ] rm -rf build diff --git a/.testing/p0/MOM_input b/.testing/p0/MOM_input new file mode 100644 index 0000000000..8f751d7bf1 --- /dev/null +++ b/.testing/p0/MOM_input @@ -0,0 +1,505 @@ +! This input file provides the adjustable run-time parameters for version 6 of the Modular Ocean Model (MOM6). +! 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. + +! === module MOM_domains === +NIGLOBAL = 32 ! + ! 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 = 32 ! + ! 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. +LAYOUT = 1, 1 + ! The processor layout that was actually used. + +! === module MOM === +THICKNESSDIFFUSE = True ! [Boolean] default = False + ! If true, interface heights are diffused with a coefficient of KHTH. +THICKNESSDIFFUSE_FIRST = True ! [Boolean] default = False + ! If true, do thickness diffusion before dynamics. This is only used if + ! THICKNESSDIFFUSE 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, + ! unless THERMO_SPANS_COUPLING is true, in which case DT_THERM can be an integer + ! multiple of the coupling timestep. 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 0, DTBT will be set 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 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_fixed_initialization === +INPUTDIR = "INPUT" ! default = "." + ! The directory in which input files are found. + +! === 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 = -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. + ! bbuilder - build topography from list of functions. + ! benchmark - use the benchmark test case topography. + ! Neverworld - use the Neverworld 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. + ! Kelvin - flat but with rotated land mask. + ! seamount - Gaussian bump for spontaneous motion test case. + ! dumbbell - Sloshing channel with reservoirs on both ends. + ! shelfwave - exponential slope for shelfwave test case. + ! Phillips - ACC-like idealized topography used in the Phillips config. + ! dense - Denmark Strait-like dense water formation and overflow. + ! 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. + +! === module MOM_verticalGrid === +! Parameters providing information about the vertical grid. +NK = 75 ! [nondim] + ! The number of model layers. + +! === module MOM_EOS === + +! === 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 === + +! === module MOM_coord_initialization === +COORD_CONFIG = "ts_range" ! default = "none" + ! This specifies how layers are to be defined: + ! ALE or none - used to avoid defining layers in ALE mode + ! 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. +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_state_initialization === +THICKNESS_CONFIG = "benchmark" ! default = "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. + ! list - read a list of positive interface depths. + ! 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. + ! Neverworld - use the Neverworld 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 - 2D lock exchange thickness ICs. + ! sloshing - sloshing gravity thickness ICs. + ! seamount - no motion test with seamount ICs. + ! dumbbell - sloshing channel ICs. + ! soliton - Equatorial Rossby soliton. + ! rossby_front - a mixed layer front in thermal wind balance. + ! USER - call a user modified routine. + +! === module benchmark_initialize_thickness === +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. + ! ISOMIP - ISOMIP initialization. + ! adjustment2d - 2d lock exchange T/S ICs. + ! sloshing - sloshing mode T/S ICs. + ! seamount - no motion test with seamount ICs. + ! dumbbell - sloshing channel ICs. + ! rossby_front - a mixed layer front in thermal wind balance. + ! SCM_CVMix_tests - used in the SCM CVMix tests. + ! USER - call a user modified routine. + +! === module MOM_diag_mediator === + +! === 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_set_visc === +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. +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). +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. +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. +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. + +! === 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_dynamics_split_RK2 === + +! === module MOM_continuity === + +! === module MOM_continuity_PPM === +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 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. + +! === module MOM_CoriolisAdv === +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_PressureForce === + +! === module MOM_PressureForce_AFV === + +! === 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 biharmonic viscosity. The final viscosity is the largest of this + ! scaled viscosity, the Smagorinsky and Leith viscosities, 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 === +MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 + ! The maximum velocity allowed before the velocity components are truncated. + +! === 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 maxCFL_BT_cont to be accommodated. +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 + ! tendency 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. +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_mixed_layer_restrat === +MIXEDLAYER_RESTRAT = True ! [Boolean] default = False + ! If true, a density-gradient dependent re-stratifying flow is imposed in the + ! mixed layer. Can be used in ALE mode without restriction but in layer mode can + ! only be used if BULKMIXEDLAYER is true. +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_diagnostics === + +! === module MOM_diabatic_driver === +! The following parameters are used for diabatic processes. + +! === 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_set_diffusivity === + +! === module MOM_bkgnd_mixing === +! Adding static vertical background mixing coefficients +KD = 2.0E-05 ! [m2 s-1] default = 0.0 + ! The background diapycnal diffusivity of density in the interior. Zero or the + ! molecular value, ~1e-7 m2 s-1, may be used. + +! === module MOM_kappa_shear === +! Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008 +USE_JACKSON_PARAM = True ! [Boolean] default = False + ! If true, use the Jackson-Hallberg-Legg (JPO 2008) shear mixing + ! parameterization. +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_diabatic_aux === +! The following parameters are used for auxiliary 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. + +! === module MOM_mixed_layer === +MSTAR = 0.3 ! [nondim] default = 1.2 + ! The ratio of the friction velocity cubed to the TKE input to the 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. +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 average depth at which penetrating shortwave radiation is + ! absorbed is adjusted to match the average heating depth of an exponential + ! profile by moving some of the heating upward in the water column. + +! === 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_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. +ENERGYSAVEDAYS = 0.25 ! [days] default = 1.0 + ! The interval in units of TIMEUNIT between saves of the energies of the run and + ! other globally summed diagnostics. + +! === module MOM_surface_forcing === +BUOY_CONFIG = "linear" ! default = "zero" + ! The character string that indicates how buoyancy forcing is specified. Valid + ! options include (file), (zero), (linear), (USER), (BFB) and (NONE). +WIND_CONFIG = "gyres" ! default = "zero" + ! 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] default = 0.0 + ! 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. +GUST_CONST = 0.02 ! [Pa] default = 0.0 + ! The background gustiness in the winds. + +! === 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 = 3.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. +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. + +! === module MOM_write_cputime === +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. + +! Debugging parameters set to non-default values +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. diff --git a/.testing/p0/MOM_override b/.testing/p0/MOM_override new file mode 100644 index 0000000000..e69de29bb2 diff --git a/.testing/p0/diag_table b/.testing/p0/diag_table new file mode 100644 index 0000000000..68c71dd2c4 --- /dev/null +++ b/.testing/p0/diag_table @@ -0,0 +1,91 @@ +"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 + +# testing +# ======= +#"ocean_model","Kv_u","Kv_u","prog","all",.false.,"none",2 +#"ocean_model","Kv_v","Kv_v","prog","all",.false.,"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/p0/input.nml b/.testing/p0/input.nml new file mode 100644 index 0000000000..41555b8822 --- /dev/null +++ b/.testing/p0/input.nml @@ -0,0 +1,22 @@ + &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 + domains_stack_size = 14256000 + stack_size =0 / + +!&ocean_solo_nml +! hours = 1 +! !days = 1 +!/ diff --git a/.testing/tc0/MOM_input b/.testing/tc0/MOM_input index ff64c55803..e4d1694e72 100644 --- a/.testing/tc0/MOM_input +++ b/.testing/tc0/MOM_input @@ -230,7 +230,6 @@ ENERGYSAVEDAYS = 1.0 DIAG_AS_CHKSUM = True DEBUG = True -DEFAULT_2018_ANSWERS = True ! [Boolean] default = True GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True USE_GM_WORK_BUG = True ! [Boolean] default = True FIX_UNSPLIT_DT_VISC_BUG = False ! [Boolean] default = False diff --git a/.testing/tc1/MOM_input b/.testing/tc1/MOM_input index 68674f7a86..151c093ff9 100644 --- a/.testing/tc1/MOM_input +++ b/.testing/tc1/MOM_input @@ -575,7 +575,6 @@ ENERGYSAVEDAYS = 0.125 ! [days] default = 3600.0 DIAG_AS_CHKSUM = True DEBUG = True USE_PSURF_IN_EOS = False ! [Boolean] default = False -DEFAULT_2018_ANSWERS = True ! [Boolean] default = True GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True INTERPOLATE_RES_FN = True ! [Boolean] default = True GILL_EQUATORIAL_LD = False ! [Boolean] default = False diff --git a/.testing/tc2/MOM_input b/.testing/tc2/MOM_input index 1818390192..ca84d1c382 100644 --- a/.testing/tc2/MOM_input +++ b/.testing/tc2/MOM_input @@ -610,7 +610,6 @@ DIAG_AS_CHKSUM = True DEBUG = True USE_GM_WORK_BUG = False USE_PSURF_IN_EOS = False ! [Boolean] default = False -DEFAULT_2018_ANSWERS = True ! [Boolean] default = True GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True REMAP_UV_USING_OLD_ALG = True ! [Boolean] default = True USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False diff --git a/.testing/tc3/MOM_input b/.testing/tc3/MOM_input index 9112898b4c..a034960d1e 100644 --- a/.testing/tc3/MOM_input +++ b/.testing/tc3/MOM_input @@ -469,7 +469,6 @@ ENERGYSAVEDAYS = 3.0 ! [hours] default = 1.44E+04 ! energies of the run and other globally summed diagnostics. DIAG_AS_CHKSUM = True DEBUG = True -DEFAULT_2018_ANSWERS = True ! [Boolean] default = True OBC_RADIATION_MAX = 10.0 ! [nondim] default = 10.0 GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True USE_GM_WORK_BUG = True ! [Boolean] default = True diff --git a/.testing/tc4/MOM_input b/.testing/tc4/MOM_input index 04598a9dc9..e33bf40bf6 100644 --- a/.testing/tc4/MOM_input +++ b/.testing/tc4/MOM_input @@ -409,7 +409,6 @@ DIAG_AS_CHKSUM = True DEBUG = True USE_PSURF_IN_EOS = False ! [Boolean] default = False -DEFAULT_2018_ANSWERS = True ! [Boolean] default = True GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True INTERPOLATE_RES_FN = True ! [Boolean] default = True GILL_EQUATORIAL_LD = False ! [Boolean] default = False diff --git a/.testing/tools/compare_clocks.py b/.testing/tools/compare_clocks.py new file mode 100755 index 0000000000..77198fda6a --- /dev/null +++ b/.testing/tools/compare_clocks.py @@ -0,0 +1,88 @@ +#!/usr/bin/env python +import argparse +import json + +# Ignore timers below this threshold (in seconds) +DEFAULT_THRESHOLD = 0.05 + +# Thresholds for reporting +DT_WARN = 0.10 # Slowdown warning +DT_FAIL = 0.25 # Slowdown abort + +ANSI_RED = '\033[31m' +ANSI_GREEN = '\033[32m' +ANSI_YELLOW = '\033[33m' +ANSI_RESET = '\033[0m' + + +def main(): + desc = ( + 'Compare two FMS clock output files and report any differences within ' + 'a defined threshold.' + ) + + parser = argparse.ArgumentParser(description=desc) + parser.add_argument('expt') + parser.add_argument('ref') + parser.add_argument('--threshold') + parser.add_argument('--verbose', action='store_true') + args = parser.parse_args() + + threshold = float(args.threshold) if args.threshold else DEFAULT_THRESHOLD + verbose = args.verbose + + clock_cmp = {} + + print('{:35s}{:8s} {:8s}'.format('', 'Profile', 'Reference')) + print() + + with open(args.expt) as log_expt, open(args.ref) as log_ref: + clocks_expt = json.load(log_expt)['clocks'] + clocks_ref = json.load(log_ref)['clocks'] + + # Gather timers which appear in both clocks + clock_tags = [clk for clk in clocks_expt if clk in clocks_ref] + + for clk in clock_tags: + clock_cmp[clk] = {} + + # For now, we only comparge tavg, the rank-averaged timing + rec = 'tavg' + + t_expt = clocks_expt[clk][rec] + t_ref = clocks_ref[clk][rec] + + # Compare the relative runtimes + if all(t > threshold for t in (t_expt, t_ref)): + dclk = (t_expt - t_ref) / t_ref + else: + dclk = 0. + clock_cmp[clk][rec] = dclk + + # Skip trivially low clocks + if all(t < threshold for t in (t_expt, t_ref)) and not verbose: + continue + + # Report the time differences + ansi_color = ANSI_RESET + + if abs(t_expt - t_ref) > threshold: + if dclk > DT_FAIL: + ansi_color = ANSI_RED + elif dclk > DT_WARN: + ansi_color = ANSI_YELLOW + elif dclk < -DT_WARN: + ansi_color = ANSI_GREEN + + print('{}{}: {:7.3f}s, {:7.3f}s ({:.1f}%){}'.format( + ansi_color, + ' ' * (32 - len(clk)) + clk, + t_expt, + t_ref, + 100. * dclk, + ANSI_RESET, + )) + + +if __name__ == '__main__': + main() diff --git a/.testing/tools/compare_perf.py b/.testing/tools/compare_perf.py new file mode 100755 index 0000000000..e4a651c709 --- /dev/null +++ b/.testing/tools/compare_perf.py @@ -0,0 +1,110 @@ +#!/usr/bin/env python +import argparse +import json + +# Ignore timers below this threshold (in seconds) +DEFAULT_THRESHOLD = 0.05 + +# Thresholds for reporting +DT_WARN = 0.10 # Slowdown warning +DT_FAIL = 0.25 # Slowdown abort + +ANSI_RED = '\033[31m' +ANSI_GREEN = '\033[32m' +ANSI_YELLOW = '\033[33m' +ANSI_RESET = '\033[0m' + + +def main(): + desc = ( + 'Compare two FMS clock output files and report any differences within ' + 'a defined threshold.' + ) + + parser = argparse.ArgumentParser(description=desc) + parser.add_argument('expt') + parser.add_argument('ref') + parser.add_argument('--threshold') + parser.add_argument('--verbose', action='store_true') + args = parser.parse_args() + + threshold = float(args.threshold) if args.threshold else DEFAULT_THRESHOLD + verbose = args.verbose + + clock_cmp = {} + + print('{:35s}{:8s} {:8s}'.format('', 'Profile', 'Reference')) + print() + + with open(args.expt) as profile_expt, open(args.ref) as profile_ref: + perf_expt = json.load(profile_expt) + perf_ref = json.load(profile_ref) + + events = [ev for ev in perf_expt if ev in perf_ref] + + for event in events: + # For now, only report the times + if event not in ('task-clock', 'cpu-clock'): + continue + + count_expt = perf_expt[event]['count'] + count_ref = perf_ref[event]['count'] + + symbols_expt = perf_expt[event]['symbol'] + symbols_ref = perf_ref[event]['symbol'] + + symbols = [ + s for s in symbols_expt + if s in symbols_ref + and not s.startswith('0x') + ] + + for symbol in symbols: + t_expt = float(symbols_expt[symbol]) / 1e9 + t_ref = float(symbols_ref[symbol]) / 1e9 + + # Compare the relative runtimes + if all(t > threshold for t in (t_expt, t_ref)): + dclk = (t_expt - t_ref) / t_ref + else: + dclk = 0. + + # Skip trivially low clocks + if all(t < threshold for t in (t_expt, t_ref)) and not verbose: + continue + + # Report the time differences + ansi_color = ANSI_RESET + + if abs(t_expt - t_ref) > threshold: + if dclk > DT_FAIL: + ansi_color = ANSI_RED + elif dclk > DT_WARN: + ansi_color = ANSI_YELLOW + elif dclk < -DT_WARN: + ansi_color = ANSI_GREEN + + # Remove module name + sname = symbol.split('_MOD_', 1)[-1] + + # Strip version from glibc calls + sname = sname.split('@')[0] + + # Remove GCC optimization renaming + sname = sname.replace('.constprop.0', '') + + if len(sname) > 32: + sname = sname[:29] + '...' + + print('{}{}: {:7.3f}s, {:7.3f}s ({:.1f}%){}'.format( + ansi_color, + ' ' * (32 - len(sname)) + sname, + t_expt, + t_ref, + 100. * dclk, + ANSI_RESET, + )) + + +if __name__ == '__main__': + main() diff --git a/.testing/tools/parse_fms_clocks.py b/.testing/tools/parse_fms_clocks.py new file mode 100755 index 0000000000..b57fc481ab --- /dev/null +++ b/.testing/tools/parse_fms_clocks.py @@ -0,0 +1,120 @@ +#!/usr/bin/env python +import argparse +import collections +import json +import os +import sys + +import f90nml + +record_type = collections.defaultdict(lambda: float) +for rec in ('grain', 'pemin', 'pemax',): + record_type[rec] = int + + +def main(): + desc = 'Parse MOM6 model stdout and return clock data in JSON format.' + + parser = argparse.ArgumentParser(description=desc) + parser.add_argument('--format', '-f', action='store_true') + parser.add_argument('--dir', '-d') + parser.add_argument('log') + args = parser.parse_args() + + config = {} + + if args.dir: + # Gather model configuration + input_nml = os.path.join(args.dir, 'input.nml') + nml = f90nml.read(input_nml) + config['input.nml'] = nml.todict() + + parameter_filenames = [ + ('params', 'MOM_parameter_doc.all'), + ('layout', 'MOM_parameter_doc.layout'), + ('debug', 'MOM_parameter_doc.debugging'), + ] + for key, fname in parameter_filenames: + config[key] = {} + with open(os.path.join(args.dir, fname)) as param_file: + params = parse_mom6_param(param_file) + config[key].update(params) + + # Get log path + if os.path.isfile(args.log): + log_path = args.log + elif os.path.isfile(os.path.join(args.dir, args.log)): + log_path = os.path.join(args.dir, args.log) + else: + sys.exit('stdout log not found.') + + # Parse timings + with open(log_path) as log: + clocks = parse_clocks(log) + + config['clocks'] = clocks + + if args.format: + print(json.dumps(config, indent=4)) + else: + print(json.dumps(config)) + + +def parse_mom6_param(param_file): + params = {} + for line in param_file: + param_stmt = line.split('!')[0].strip() + if param_stmt: + key, val = [s.strip() for s in param_stmt.split('=')] + + # TODO: Convert to equivalent Python types + if val in ('True', 'False'): + params[key] = bool(val) + else: + params[key] = val + + return params + + +def parse_clocks(log): + clock_start_msg = 'Tabulating mpp_clock statistics across' + clock_end_msg = 'MPP_STACK high water mark=' + + fields = [] + for line in log: + if line.startswith(clock_start_msg): + npes = line.lstrip(clock_start_msg).split()[0] + + # Get records + fields = [] + line = next(log) + + # Skip blank lines + while line.isspace(): + line = next(log) + + fields = line.split() + + # Exit this loop, begin clock parsing + break + + clocks = {} + for line in log: + # Treat MPP_STACK usage as end of clock reports + if line.lstrip().startswith(clock_end_msg): + break + + record = line.split()[-len(fields):] + + clk = line.split(record[0])[0].strip() + clocks[clk] = {} + + for fld, rec in zip(fields, record): + rtype = record_type[fld] + clocks[clk][fld] = rtype(rec) + + return clocks + + +if __name__ == '__main__': + main() diff --git a/.testing/tools/parse_perf.py b/.testing/tools/parse_perf.py new file mode 100755 index 0000000000..b86b1cc106 --- /dev/null +++ b/.testing/tools/parse_perf.py @@ -0,0 +1,71 @@ +#!/usr/bin/env python +import argparse +import collections +import json +import os +import shlex +import subprocess +import sys + + +def main(): + desc = 'Parse perf.data and return in JSON format.' + + parser = argparse.ArgumentParser(description=desc) + parser.add_argument('--format', '-f', action='store_true') + parser.add_argument('data') + args = parser.parse_args() + + profile = parse_perf_report(args.data) + + if args.format: + print(json.dumps(profile, indent=4)) + else: + print(json.dumps(profile)) + + +def parse_perf_report(perf_data_path): + profile = {} + + cmd = shlex.split( + 'perf report -s symbol,period -i {}'.format(perf_data_path) + ) + with subprocess.Popen(cmd, stdout=subprocess.PIPE, text=True) as proc: + event_name = None + for line in proc.stdout: + # Skip blank lines: + if not line or line.isspace(): + continue + + # Set the current event + if line.startswith('# Samples: '): + event_name = line.split()[-1].strip("'") + + # Remove perf modifiers for now + event_name = event_name.rsplit(':', 1)[0] + + profile[event_name] = {} + profile[event_name]['symbol'] = {} + + # Get total count + elif line.startswith('# Event count '): + event_count = int(line.split()[-1]) + profile[event_name]['count'] = event_count + + # skip all other 'comment' lines + elif line.startswith('#'): + continue + + # get per-symbol count + else: + tokens = line.split() + symbol = tokens[2] + period = int(tokens[3]) + + profile[event_name]['symbol'][symbol] = period + + return profile + + +if __name__ == '__main__': + main() diff --git a/ac/configure.ac b/ac/configure.ac index 9cb7147846..3d1af81b05 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -65,7 +65,7 @@ AS_IF([test "x$with_driver" != "x"], MODEL_FRAMEWORK=${srcdir}/config_src/infra/FMS1 AC_ARG_WITH([framework], AS_HELP_STRING([--with-framework=fms1|fms2], [Select the model framework])) -AS_CASE([with_framework], +AS_CASE(["$with_framework"], [fms1], [MODEL_FRAMEWORK=${srcdir}/config_src/infra/FMS1], [fms2], [MODEL_FRAMEWORK=${srcdir}/config_src/infra/FMS2], [MODEL_FRAMEWORK=${srcdir}/config_src/infra/FMS1] diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index c3e13329f2..50ea6c943d 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -195,8 +195,8 @@ module ocean_model_mod type(unit_scale_type), pointer :: & US => NULL() !< A pointer to a structure containing dimensional !! unit scaling factors. - type(MOM_control_struct), pointer :: & - MOM_CSp => NULL() !< A pointer to the MOM control structure + type(MOM_control_struct) :: MOM_CSp + !< MOM control structure type(ice_shelf_CS), pointer :: & Ice_shelf_CSp => NULL() !< A pointer to the control structure for the !! ice shelf model that couples with MOM6. This diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index 9b40a9e7b4..3bd0e1e28d 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -195,8 +195,8 @@ module MOM_ocean_model_mct !! about the vertical grid. type(unit_scale_type), pointer :: US => NULL() !< A pointer to a structure containing !! dimensional unit scaling factors. - type(MOM_control_struct), pointer :: & - MOM_CSp => NULL() !< A pointer to the MOM control structure + type(MOM_control_struct) :: MOM_CSp + !< MOM control structure type(ice_shelf_CS), pointer :: & Ice_shelf_CSp => NULL() !< A pointer to the control structure for the !! ice shelf model that couples with MOM6. This diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 95eeece965..1064c13d85 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -201,8 +201,8 @@ module MOM_ocean_model_nuopc !! about the vertical grid. type(unit_scale_type), pointer :: US => NULL() !< A pointer to a structure containing !! dimensional unit scaling factors. - type(MOM_control_struct), pointer :: & - MOM_CSp => NULL() !< A pointer to the MOM control structure + type(MOM_control_struct) :: MOM_CSp + !< MOM control structure type(ice_shelf_CS), pointer :: & Ice_shelf_CSp => NULL() !< A pointer to the control structure for the !! ice shelf model that couples with MOM6. This diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index ebb953be93..7dfce01f68 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -180,8 +180,7 @@ program MOM_main ! and diffusion equation are read in from files stored from ! a previous integration of the prognostic model - type(MOM_control_struct), pointer :: MOM_CSp => NULL() - !> A pointer to the tracer flow control structure. + type(MOM_control_struct) :: MOM_CSp !> MOM control structure type(tracer_flow_control_CS), pointer :: & tracer_flow_CSp => NULL() !< A pointer to the tracer flow control structure type(surface_forcing_CS), pointer :: surface_forcing_CSp => NULL() diff --git a/config_src/infra/FMS1/MOM_domain_infra.F90 b/config_src/infra/FMS1/MOM_domain_infra.F90 index 029561946b..590637158f 100644 --- a/config_src/infra/FMS1/MOM_domain_infra.F90 +++ b/config_src/infra/FMS1/MOM_domain_infra.F90 @@ -156,6 +156,9 @@ module MOM_domain_infra !! would be contain only land points and are not !! assigned to actual processors. This need not be !! assigned if all logical processors are used. + integer :: turns !< Number of quarter-turns from input to this grid. + type(MOM_domain_type), pointer :: domain_in => NULL() + !< Reference to unrotated domain (if turned) end type MOM_domain_type integer, parameter :: To_All = To_East + To_West + To_North + To_South !< A flag for passing in all directions @@ -1396,6 +1399,9 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l mask_table_exists = .false. endif + ! Initialize as an unrotated domain + MOM_dom%turns = 0 + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain) !For downsampled domain, recommend a halo of 1 (or 0?) since we're not doing wide-stencil computations. @@ -1487,8 +1493,9 @@ end subroutine get_domain_components_d2D !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain_name, & turns, refine, extra_halo) - type(MOM_domain_type), intent(in) :: MD_in !< An existing MOM_domain - type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be + type(MOM_domain_type), target, intent(in) :: MD_in !< An existing MOM_domain + type(MOM_domain_type), pointer :: MOM_dom + !< A pointer to a MOM_domain that will be !! allocated if it is unassociated, and will have data !! copied from MD_in integer, dimension(2), & @@ -1619,8 +1626,12 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%name = MD_in%name endif - call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) + MOM_dom%turns = qturns + if (qturns /= 0) then + MOM_dom%domain_in => MD_in + endif + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, domain_name=MOM_dom%name, coarsen=2) end subroutine clone_MD_to_MD diff --git a/config_src/infra/FMS1/MOM_interp_infra.F90 b/config_src/infra/FMS1/MOM_interp_infra.F90 index 170573f7ec..774f6a67d2 100644 --- a/config_src/infra/FMS1/MOM_interp_infra.F90 +++ b/config_src/infra/FMS1/MOM_interp_infra.F90 @@ -231,7 +231,7 @@ end subroutine time_interp_extern_3d !> initialize an external field integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & - threading, ierr, ignore_axis_atts ) + threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency ) character(len=*), intent(in) :: file !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -246,13 +246,20 @@ integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, logical, optional, intent(in) :: ignore_axis_atts !< If present and true, do not issue a !! fatal error if the axis Cartesian attribute is !! not set to a recognized value. + logical, optional, intent(in) :: correct_leap_year_inconsistency !< If present and true, + !! then if, (1) a calendar containing leap years + !! is in use, and (2) the modulo time period of the + !! data is an integer number of years, then map + !! a model date of Feb 29. onto a common year on Feb. 28. if (present(MOM_Domain)) then init_extern_field = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) else init_extern_field = init_external_field(file, fieldname, domain=domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) endif end function init_extern_field diff --git a/config_src/infra/FMS1/MOM_io_infra.F90 b/config_src/infra/FMS1/MOM_io_infra.F90 index dcbd80e723..1501f3171b 100644 --- a/config_src/infra/FMS1/MOM_io_infra.F90 +++ b/config_src/infra/FMS1/MOM_io_infra.F90 @@ -31,7 +31,7 @@ module MOM_io_infra ! These interfaces are actually implemented or have explicit interfaces in this file. public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix -public :: MOM_read_data, MOM_read_vector, write_metadata, write_field +public :: read_field, read_vector, write_metadata, write_field public :: field_exists, get_field_atts, get_field_size, get_axis_data, read_field_chksum public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root @@ -55,13 +55,13 @@ module MOM_io_infra end interface open_file !> Read a data field from a file -interface MOM_read_data - module procedure MOM_read_data_4d - module procedure MOM_read_data_3d - module procedure MOM_read_data_2d, MOM_read_data_2d_region - module procedure MOM_read_data_1d, MOM_read_data_1d_int - module procedure MOM_read_data_0d, MOM_read_data_0d_int -end interface +interface read_field + module procedure read_field_4d + module procedure read_field_3d + module procedure read_field_2d, read_field_2d_region + module procedure read_field_1d, read_field_1d_int + module procedure read_field_0d, read_field_0d_int +end interface read_field !> Write a registered field to an output file interface write_field @@ -74,10 +74,10 @@ module MOM_io_infra end interface write_field !> Read a pair of data fields representing the two components of a vector from a file -interface MOM_read_vector +interface read_vector module procedure MOM_read_vector_3d module procedure MOM_read_vector_2d -end interface MOM_read_vector +end interface read_vector !> Write metadata about a variable or axis to a file and store it for later reuse interface write_metadata @@ -416,8 +416,8 @@ end subroutine get_axis_data !> This routine uses the fms_io subroutine read_data to read a scalar named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & - global_file, file_may_be_4d) +subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, intent(inout) :: data !< The 1-dimensional array into which the data @@ -471,12 +471,11 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom if (present(scale)) then ; if (scale /= 1.0) then data = scale*data endif ; endif - -end subroutine MOM_read_data_0d +end subroutine read_field_0d !> This routine uses the fms_io subroutine read_data to read a 1-D data field named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & +subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file @@ -521,7 +520,7 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 1-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 1-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -534,14 +533,13 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom if (present(scale)) then ; if (scale /= 1.0) then data(:) = scale*data(:) endif ; endif - -end subroutine MOM_read_data_1d +end subroutine read_field_1d !> This routine uses the fms_io subroutine read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file, file_may_be_4d) +subroutine read_field_2d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -589,7 +587,7 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 2-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 2-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -598,13 +596,12 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif - -end subroutine MOM_read_data_2d +end subroutine read_field_2d !> This routine uses the fms_io subroutine read_data to read a region from a distributed or !! global 2-D data field named "fieldname" from file "filename". -subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & - no_domain, scale) +subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -637,13 +634,12 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ data(:,:) = scale*data(:,:) endif endif ; endif - -end subroutine MOM_read_data_2d_region +end subroutine read_field_2d_region !> This routine uses the fms_io subroutine read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & +subroutine read_field_3d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file @@ -692,7 +688,7 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 3-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 3-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -701,13 +697,12 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif - -end subroutine MOM_read_data_3d +end subroutine read_field_3d !> This routine uses the fms_io subroutine read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & +subroutine read_field_4d(filename, fieldname, data, MOM_Domain, & timelevel, position, scale, global_file) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file @@ -754,7 +749,7 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & endif enddo if ((n == nvar+1) .or. (nvar < 1)) call MOM_error(WARNING, & - "MOM_read_data apparently did not find 4-d variable "//trim(fieldname)//" in file "//trim(filename)) + "read_field apparently did not find 4-d variable "//trim(fieldname)//" in file "//trim(filename)) deallocate(fields) call mpp_close(unit) @@ -762,32 +757,29 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & if (present(scale)) then ; if (scale /= 1.0) then call rescale_comp_data(MOM_Domain, data, scale) endif ; endif - -end subroutine MOM_read_data_4d +end subroutine read_field_4d !> This routine uses the fms_io subroutine read_data to read a scalar integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) +subroutine read_field_0d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) - -end subroutine MOM_read_data_0d_int +end subroutine read_field_0d_int !> This routine uses the fms_io subroutine read_data to read a 1-D integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) +subroutine read_field_1d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data integer, optional, intent(in) :: timelevel !< The time level in the file to read call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) - -end subroutine MOM_read_data_1d_int +end subroutine read_field_1d_int !> This routine uses the fms_io subroutine read_data to read a pair of distributed diff --git a/config_src/infra/FMS2/MOM_domain_infra.F90 b/config_src/infra/FMS2/MOM_domain_infra.F90 index 029561946b..5f8d5fb20b 100644 --- a/config_src/infra/FMS2/MOM_domain_infra.F90 +++ b/config_src/infra/FMS2/MOM_domain_infra.F90 @@ -156,6 +156,9 @@ module MOM_domain_infra !! would be contain only land points and are not !! assigned to actual processors. This need not be !! assigned if all logical processors are used. + integer :: turns !< Number of quarter-turns from input to this grid. + type(MOM_domain_type), pointer :: domain_in => NULL() + !< Reference to unrotated domain (if turned) end type MOM_domain_type integer, parameter :: To_All = To_East + To_West + To_North + To_South !< A flag for passing in all directions @@ -1396,6 +1399,9 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l mask_table_exists = .false. endif + ! Initialize as an unrotated domain + MOM_dom%turns = 0 + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain) !For downsampled domain, recommend a halo of 1 (or 0?) since we're not doing wide-stencil computations. @@ -1403,7 +1409,6 @@ subroutine create_MOM_domain(MOM_dom, n_global, n_halo, reentrant, tripolar_N, l !error: downsample_diag_indices_get: peculiar size 28 in i-direction\ndoes not match one of 24 25 26 27 ! call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, halo_size=(MOM_dom%nihalo/2), coarsen=2) call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, coarsen=2) - end subroutine create_MOM_domain !> dealloc_MOM_domain deallocates memory associated with a pointer to a MOM_domain_type @@ -1487,8 +1492,9 @@ end subroutine get_domain_components_d2D !! some properties of the new type to differ from the original one. subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain_name, & turns, refine, extra_halo) - type(MOM_domain_type), intent(in) :: MD_in !< An existing MOM_domain - type(MOM_domain_type), pointer :: MOM_dom !< A pointer to a MOM_domain that will be + type(MOM_domain_type), target, intent(in) :: MD_in !< An existing MOM_domain + type(MOM_domain_type), pointer :: MOM_dom + !< A pointer to a MOM_domain that will be !! allocated if it is unassociated, and will have data !! copied from MD_in integer, dimension(2), & @@ -1619,8 +1625,12 @@ subroutine clone_MD_to_MD(MD_in, MOM_dom, min_halo, halo_size, symmetric, domain MOM_dom%name = MD_in%name endif - call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) + MOM_dom%turns = qturns + if (qturns /= 0) then + MOM_dom%domain_in => MD_in + endif + call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain, xextent=exni, yextent=exnj) call clone_MD_to_d2D(MOM_dom, MOM_dom%mpp_domain_d2, domain_name=MOM_dom%name, coarsen=2) end subroutine clone_MD_to_MD diff --git a/config_src/infra/FMS2/MOM_interp_infra.F90 b/config_src/infra/FMS2/MOM_interp_infra.F90 index 170573f7ec..b02beca313 100644 --- a/config_src/infra/FMS2/MOM_interp_infra.F90 +++ b/config_src/infra/FMS2/MOM_interp_infra.F90 @@ -231,7 +231,7 @@ end subroutine time_interp_extern_3d !> initialize an external field integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, & - threading, ierr, ignore_axis_atts ) + threading, ierr, ignore_axis_atts, correct_leap_year_inconsistency ) character(len=*), intent(in) :: file !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -246,13 +246,22 @@ integer function init_extern_field(file, fieldname, MOM_domain, domain, verbose, logical, optional, intent(in) :: ignore_axis_atts !< If present and true, do not issue a !! fatal error if the axis Cartesian attribute is !! not set to a recognized value. + logical, optional, intent(in) :: correct_leap_year_inconsistency !< If present and true, + !! then if, (1) a calendar containing leap years + !! is in use, and (2) the modulo time period of the + !! data is an integer number of years, then map + !! a model date of Feb 29. onto a common year on Feb. 28. + + if (present(MOM_Domain)) then init_extern_field = init_external_field(file, fieldname, domain=MOM_domain%mpp_domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) else init_extern_field = init_external_field(file, fieldname, domain=domain, & - verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts) + verbose=verbose, threading=threading, ierr=ierr, ignore_axis_atts=ignore_axis_atts, & + correct_leap_year_inconsistency=correct_leap_year_inconsistency) endif end function init_extern_field diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 6f08065f57..0b8c19d836 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -42,7 +42,7 @@ module MOM_io_infra ! These interfaces are actually implemented or have explicit interfaces in this file. public :: open_file, open_ASCII_file, file_is_open, close_file, flush_file, file_exists public :: get_file_info, get_file_fields, get_file_times, get_filename_suffix -public :: MOM_read_data, MOM_read_vector, write_metadata, write_field +public :: read_field, read_vector, write_metadata, write_field public :: field_exists, get_field_atts, get_field_size, get_axis_data, read_field_chksum public :: io_infra_init, io_infra_end, MOM_namelist_file, check_namelist_error, write_version public :: stdout_if_root @@ -66,12 +66,12 @@ module MOM_io_infra end interface open_file !> Read a data field from a file -interface MOM_read_data - module procedure MOM_read_data_4d - module procedure MOM_read_data_3d - module procedure MOM_read_data_2d, MOM_read_data_2d_region - module procedure MOM_read_data_1d, MOM_read_data_1d_int - module procedure MOM_read_data_0d, MOM_read_data_0d_int +interface read_field + module procedure read_field_4d + module procedure read_field_3d + module procedure read_field_2d, read_field_2d_region + module procedure read_field_1d, read_field_1d_int + module procedure read_field_0d, read_field_0d_int end interface !> Write a registered field to an output file @@ -85,10 +85,10 @@ module MOM_io_infra end interface write_field !> Read a pair of data fields representing the two components of a vector from a file -interface MOM_read_vector - module procedure MOM_read_vector_3d - module procedure MOM_read_vector_2d -end interface MOM_read_vector +interface read_vector + module procedure read_vector_3d + module procedure read_vector_2d +end interface read_vector !> Write metadata about a variable or axis to a file and store it for later reuse interface write_metadata @@ -659,8 +659,8 @@ end subroutine get_axis_data !> This routine uses the fms_io subroutine read_data to read a scalar named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & - global_file, file_may_be_4d) +subroutine read_field_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, intent(inout) :: data !< The 1-dimensional array into which the data @@ -686,7 +686,7 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj_DD, fieldname, "MOM_read_data_0d: ", filename, & + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_0d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -705,7 +705,7 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_0d: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_0d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -727,12 +727,12 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom data = scale*data endif ; endif -end subroutine MOM_read_data_0d +end subroutine read_field_0d !> This routine uses the fms_io subroutine read_data to read a 1-D data field named !! "fieldname" from a single or domain-decomposed file "filename". -subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & - global_file, file_may_be_4d) +subroutine read_field_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data @@ -758,7 +758,7 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj_DD, fieldname, "MOM_read_data_1d: ", filename, & + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_1d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -777,7 +777,7 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_1d: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_1d: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -799,13 +799,13 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom data(:) = scale*data(:) endif ; endif -end subroutine MOM_read_data_1d +end subroutine read_field_1d !> This routine uses the fms_io subroutine read_data to read a distributed !! 2-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file, file_may_be_4d) +subroutine read_field_2d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -831,7 +831,7 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "MOM_read_data_2d: ", filename, & + call prepare_to_read_var(fileobj, fieldname, "read_field_2d: ", filename, & var_to_read, has_time_dim, timelevel, position) ! Read the data. @@ -852,12 +852,12 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & call rescale_comp_data(MOM_Domain, data, scale) endif ; endif -end subroutine MOM_read_data_2d +end subroutine read_field_2d !> This routine uses the fms_io subroutine read_data to read a region from a distributed or !! global 2-D data field named "fieldname" from file "filename". -subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & - no_domain, scale) +subroutine read_field_2d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:), intent(inout) :: data !< The 2-dimensional array into which the data @@ -887,7 +887,7 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj_DD, fieldname, "MOM_read_data_2d_region: ", & + call prepare_to_read_var(fileobj_DD, fieldname, "read_field_2d_region: ", & filename, var_to_read) ! Read the data. @@ -902,7 +902,7 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_2d_region: ", filename, var_to_read) + call find_varname_in_file(fileObj, fieldname, "read_field_2d_region: ", filename, var_to_read) ! Read the data. call fms2_read_data(fileobj, var_to_read, data, corner=start(1:2), edge_lengths=nread(1:2)) @@ -925,13 +925,13 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ endif endif ; endif -end subroutine MOM_read_data_2d_region +end subroutine read_field_2d_region !> This routine uses the fms_io subroutine read_data to read a distributed !! 3-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file, file_may_be_4d) +subroutine read_field_3d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:), intent(inout) :: data !< The 3-dimensional array into which the data @@ -957,7 +957,7 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "MOM_read_data_3d: ", filename, & + call prepare_to_read_var(fileobj, fieldname, "read_field_3d: ", filename, & var_to_read, has_time_dim, timelevel, position) ! Read the data. @@ -978,13 +978,13 @@ subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & call rescale_comp_data(MOM_Domain, data, scale) endif ; endif -end subroutine MOM_read_data_3d +end subroutine read_field_3d !> This routine uses the fms_io subroutine read_data to read a distributed !! 4-D data field named "fieldname" from file "filename". Valid values for !! "position" include CORNER, CENTER, EAST_FACE and NORTH_FACE. -subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & - timelevel, position, scale, global_file) +subroutine read_field_4d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file real, dimension(:,:,:,:), intent(inout) :: data !< The 4-dimensional array into which the data @@ -1009,7 +1009,7 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive variable name in the file and prepare to read it. - call prepare_to_read_var(fileobj, fieldname, "MOM_read_data_4d: ", filename, & + call prepare_to_read_var(fileobj, fieldname, "read_field_4d: ", filename, & var_to_read, has_time_dim, timelevel, position) ! Read the data. @@ -1030,11 +1030,11 @@ subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & call rescale_comp_data(MOM_Domain, data, scale) endif ; endif -end subroutine MOM_read_data_4d +end subroutine read_field_4d !> This routine uses the fms_io subroutine read_data to read a scalar integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) +subroutine read_field_0d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, intent(inout) :: data !< The 1-dimensional array into which the data @@ -1054,7 +1054,7 @@ subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_0d_int: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_0d_int: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -1070,11 +1070,11 @@ subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) endif -end subroutine MOM_read_data_0d_int +end subroutine read_field_0d_int !> This routine uses the fms_io subroutine read_data to read a 1-D integer !! data field named "fieldname" from file "filename". -subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) +subroutine read_field_1d_int(filename, fieldname, data, timelevel) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The variable name of the data in the file integer, dimension(:), intent(inout) :: data !< The 1-dimensional array into which the data @@ -1095,7 +1095,7 @@ subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) ! Find the matching case-insensitive variable name in the file, and determine whether it ! has a time dimension. - call find_varname_in_file(fileObj, fieldname, "MOM_read_data_1d_int: ", filename, & + call find_varname_in_file(fileObj, fieldname, "read_field_1d_int: ", filename, & var_to_read, has_time_dim, timelevel) ! Read the data. @@ -1111,14 +1111,14 @@ subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) call read_data(filename, fieldname, data, timelevel=timelevel, no_domain=.true.) endif -end subroutine MOM_read_data_1d_int +end subroutine read_field_1d_int !> This routine uses the fms_io subroutine read_data to read a pair of distributed !! 2-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. -subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair, scale) +subroutine read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -1152,9 +1152,9 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. - call prepare_to_read_var(fileobj, u_fieldname, "MOM_read_vector_2d: ", filename, & + call prepare_to_read_var(fileobj, u_fieldname, "read_vector_2d: ", filename, & u_var, has_time_dim, timelevel, position=u_pos) - call prepare_to_read_var(fileobj, v_fieldname, "MOM_read_vector_2d: ", filename, & + call prepare_to_read_var(fileobj, v_fieldname, "read_vector_2d: ", filename, & v_var, has_time_dim, timelevel, position=v_pos) ! Read the u-data and v-data. There would already been an error message for one @@ -1181,13 +1181,13 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data call rescale_comp_data(MOM_Domain, v_data, scale) endif ; endif -end subroutine MOM_read_vector_2d +end subroutine read_vector_2d !> This routine uses the fms_io subroutine read_data to read a pair of distributed !! 3-D data fields with names given by "[uv]_fieldname" from file "filename". Valid values for !! "stagger" include CGRID_NE, BGRID_NE, and AGRID. -subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & - timelevel, stagger, scalar_pair, scale) +subroutine read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: u_fieldname !< The variable name of the u data in the file character(len=*), intent(in) :: v_fieldname !< The variable name of the v data in the file @@ -1222,9 +1222,9 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data if (.not.success) call MOM_error(FATAL, "Failed to open "//trim(filename)) ! Find the matching case-insensitive u- and v-variable names in the file and prepare to read them. - call prepare_to_read_var(fileobj, u_fieldname, "MOM_read_vector_3d: ", filename, & + call prepare_to_read_var(fileobj, u_fieldname, "read_vector_3d: ", filename, & u_var, has_time_dim, timelevel, position=u_pos) - call prepare_to_read_var(fileobj, v_fieldname, "MOM_read_vector_3d: ", filename, & + call prepare_to_read_var(fileobj, v_fieldname, "read_vector_3d: ", filename, & v_var, has_time_dim, timelevel, position=v_pos) ! Read the u-data and v-data, dangerously assuming either both or neither have time dimensions. @@ -1251,7 +1251,7 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data call rescale_comp_data(MOM_Domain, v_data, scale) endif ; endif -end subroutine MOM_read_vector_3d +end subroutine read_vector_3d !> Find the case-sensitive name of the variable in a netCDF file with a case-insensitive name match. diff --git a/docs/discrete_space.rst b/docs/discrete_space.rst index b954915256..08a41a5f2d 100644 --- a/docs/discrete_space.rst +++ b/docs/discrete_space.rst @@ -13,7 +13,6 @@ algorithm. :maxdepth: 2 api/generated/pages/Discrete_Grids - api/generated/pages/Finite_Difference_Operators api/generated/pages/PPM api/generated/pages/Discrete_Coriolis api/generated/pages/Discrete_PG diff --git a/docs/images/background_varying.png b/docs/images/background_varying.png new file mode 100644 index 0000000000..44a65175a0 Binary files /dev/null and b/docs/images/background_varying.png differ diff --git a/docs/parameterizations_lateral.rst b/docs/parameterizations_lateral.rst index 102090b7a4..3a3266a2bb 100644 --- a/docs/parameterizations_lateral.rst +++ b/docs/parameterizations_lateral.rst @@ -43,4 +43,6 @@ Tidal forcing ------------- Astronomical tidal forcings and self-attraction and loading are implement in MOM_tidal_forcing. +Tides can also be added via an open boundary tidal specification, +see [OBC wiki page](https://github.com/NOAA-GFDL/MOM6-examples/wiki/Open-Boundary-Conditions). diff --git a/docs/parameterizations_vertical.rst b/docs/parameterizations_vertical.rst index 27285034d7..4705cf6c48 100644 --- a/docs/parameterizations_vertical.rst +++ b/docs/parameterizations_vertical.rst @@ -21,16 +21,22 @@ Interior and bottom-driven mixing --------------------------------- Kappa-shear - MOM_kappa_shear implement the shear-driven mixing of :cite:`jackson2008`. + MOM_kappa_shear implements the shear-driven mixing of :cite:`jackson2008`. Internal-tide driven mixing + The schemes of :cite:`st_laurent2002`, :cite:`polzin2009`, and :cite:`melet2012`, are all implemented through MOM_set_diffusivity and MOM_diabatic_driver. + :ref:`Internal_Vert_Mixing` + + Vertical friction ----------------- Vertical viscosity is implemented in MOM_vert_frict and coefficient computed in MOM_set_viscosity, although contributions to viscosity from other parameterizations are calculated in those respective modules (e.g. MOM_kappa_shear, MOM_KPP, MOM_energetic_PBL). + :ref:`Vertical_Viscosity` + Vertical diffusion ------------------ diff --git a/docs/tracers.rst b/docs/tracers.rst index 6190fe096d..8b5a21ee12 100644 --- a/docs/tracers.rst +++ b/docs/tracers.rst @@ -9,4 +9,5 @@ Tracers in MOM6 api/generated/pages/Horizontal_Diffusion.rst api/generated/pages/Vertical_Diffusion.rst api/generated/pages/Passive_Tracers + api/generated/pages/Frazil_Ice diff --git a/docs/zotero.bib b/docs/zotero.bib index f0e1a3b44d..bb400542b8 100644 --- a/docs/zotero.bib +++ b/docs/zotero.bib @@ -655,6 +655,30 @@ @article{killworth1992 pages = {1379--1387} } +@article{killworth1999, + doi = {10.1175/1520-0485(1999)029<1221:atbblc>2.0.co;2}, + year = 1999, + publisher = {American Meteorological Society}, + volume = {29}, + number = {6}, + pages = {1221--1238}, + author = {P. D. Killworth and N. R. Edwards}, + title = {A Turbulent Bottom Boundary Layer Code for Use in Numerical Ocean Models}, + journal = {J. Phys. Oceanography} +} + +@article{zilitinkevich1996, + doi = {10.1007/bf02430334}, + year = 1996, + publisher = {Springer Science and Business Media {LLC}}, + volume = {81}, + number = {3-4}, + pages = {325--351}, + author = {S. Zilitinkevich and D. V. Mironov}, + title = {A multi-limit formulation for the equilibrium depth of a stably stratified boundary layer}, + journal = {Boundary-Layer Meteorology} +} + @article{gent1995, title = {Parameterizing {Eddy}-{Induced} {Tracer} {Transports} in {Ocean} {Circulation} {Models}}, volume = {25}, @@ -800,6 +824,18 @@ @article{jackson2008 pages = {1033--1053} } +@article{turner1986, + doi = {10.1017/s0022112086001222}, + year = 1986, + publisher = {Cambridge University Press ({CUP})}, + volume = {173}, + pages = {431--471}, + author = {J. S. Turner}, + title = {Turbulent entrainment: the development of the entrainment assumption, and its application to geophysical flows}, + journal = {J. Fluid Mech.} +} + + @article{reichl2018, title = {A simplified energetics based planetary boundary layer ({ePBL}) approach for ocean climate simulations.}, volume = {132}, @@ -847,6 +883,16 @@ @article{melet2012 pages = {602--615} } +@article{simmons2004, + title = {Tidally driven mixing in a numerical model of the ocean general circulation}, + volume = {6}, + author = {Simmons, H. L. and S. R. Jayne and L. C. St. Laurent and A. J. Weaver}, + year = {2004}, + journal = {Ocean Modell.}, + pages = {245--263}, + doi = {10.1016/S1463-5003(03)00011-8} +} + @article{polzin2009, title = {An abyssal recipe}, volume = {30}, @@ -863,6 +909,15 @@ @article{polzin2009 pages = {298--309} } +@article{polzin2004, + title = {Idealized solutions for the energy balance of the finescale internal wave field}, + volume = {34}, + journal = {J. Phys. Oceanogr.}, + author = {Polzin, Kurt L.}, + year = {2004}, + pages = {231--246} +} + @article{white2009, title = {High-order regridding-remapping schemes for continuous isopycnal and generalized coordinates in ocean models}, volume = {228}, @@ -1407,6 +1462,18 @@ @article{harrison2008 pages = {1894--1912} } +@article{danabasoglu2012, + doi = {10.1175/jcli-d-11-00091.1}, + year = 2012, + publisher = {American Meteorological Society}, + volume = {25}, + number = {5}, + pages = {1361--1389}, + author = {G. Danabasoglu and S. C. Bates and B. P. Briegleb and S. R. Jayne and M. Jochum and W. G. Large and S. Peacock and S. G. Yeager}, + title = {The {CCSM}4 Ocean Component}, + journal = {J. Climate} +} + @article{henyey1986, title = {Energy and action flow through the internal wave field: {An} eikonal approach}, volume = {91}, @@ -1661,7 +1728,7 @@ @article{adcroft2006 pages = {224--233} } -@article{adcroft2004, +@article{adcroft2004-1, title = {Rescaled height coordinates for accurate representation of free-surface flows in ocean circulation models}, volume = {7}, issn = {1463-5003}, @@ -1742,6 +1809,18 @@ @article{large1994 pages = {363--403} } +@article{pacanowski1981, + doi = {10.1175/1520-0485(1981)011<1443:povmin>2.0.co;2}, + year = 1981, + publisher = {American Meteorological Society}, + volume = {11}, + number = {11}, + pages = {1443--1451}, + author = {R. C. Pacanowski and S. G. H. Philander}, + title = {Parameterization of Vertical Mixing in Numerical Models of Tropical Oceans}, + journal = {J. Phys. Oceanography} +} + @article{van_roekel2018, title = {The {KPP} {Boundary} {Layer} {Scheme} for the {Ocean}: {Revisiting} {Its} {Formulation} and {Benchmarking} {One}-{Dimensional} {Simulations} {Relative} to {LES}}, volume = {10}, @@ -2229,7 +2308,7 @@ @article{carpenter1990 doi = {https://doi.org/10.1175/1520-0493(1990)118<0586:AOTPPM>2.0.CO;2} } -@article{kasahara1974, +@article{kasahara1974-1, title = {Various {Vertical} {Coordinate} {Systems} {Used} for {Numerical} {Weather} {Prediction}}, volume = {102}, issn = {0027-0644}, @@ -2324,6 +2403,19 @@ @article{hallberg2000 pages = {1402--1419} } +@article{umlauf2005, + doi = {10.1016/j.csr.2004.08.004}, + year = 2005, + publisher = {Elsevier {BV}}, + volume = {25}, + number = {7-8}, + pages = {795--827}, + author = {L. Umlauf and H. Burchard}, + title = {Second-order turbulence closure models for geophysical boundary layers. A review of recent work}, + journal = {Continental Shelf Res.} +} + + @article{easter1993, title = {Two Modified Versions of Bott's Positive-Definite Numerical Advection Scheme}, @@ -2524,3 +2616,71 @@ @article{hallberg2005 volume = {8}, doi = {10.1016/j.ocemod.2004.01.001} } + +@article{bell1975, + doi = {10.1017/s0022112075000560}, + year = 1975, + publisher = {Cambridge University Press ({CUP})}, + volume = {67}, + number = {4}, + pages = {705--722}, + author = {T. H. Bell}, + title = {Lee waves in stratified flows with simple harmonic time dependence}, + journal = {J. Fluid Mech.} +} + +@article{nikurashin2010a, + doi = {10.1175/2009jpo4199.1}, + year = 2010, + publisher = {American Meteorological Society}, + volume = {40}, + number = {5}, + pages = {1055--1074}, + author = {M. Nikurashin and R. Ferrari}, + title = {Radiation and Dissipation of Internal Waves Generated by Geostrophic Motions Impinging on Small-Scale Topography: Theory}, + journal = {J. Phys. Oceanography} +} + +@article{nikurashin2010b, + doi = {10.1175/2010jpo4315.1}, + year = 2010, + publisher = {American Meteorological Society}, + volume = {40}, + number = {9}, + pages = {2025--2042}, + author = {M. Nikurashin and R. Ferrari}, + title = {Radiation and Dissipation of Internal Waves Generated by Geostrophic Motions Impinging on Small-Scale Topography: Application to the Southern Ocean}, + journal = {J. Phys. Oceanography} +} + +@article{miles1961, + title = {On the stability of heterogeneous shear flows}, + author = {JW Miles}, + year = {1961}, + journal = {J. of Fluid Mech.}, + volume = {10}, + pages = {496--508}, + doi = {10.1017/S0022112061000305} +} + +@article{bryan1979, + doi = {10.1029/jc084ic05p02503}, + year = 1979, + publisher = {American Geophysical Union ({AGU})}, + volume = {84}, + number = {C5}, + pages = {2503}, + author = {K. Bryan and L. J. Lewis}, + title = {A water mass model of the World Ocean}, + journal = {J. Geophys. Res.} +} + +@techreport{griffies2015a, + author = {S. M. Griffies and M. Levy and A. J. Adcroft and G. Danabasoglu and R. + W. Hallberg and D. Jacobsen and W. Large and T. Ringler}, + title = {Theory and Numerics of the Community Ocean Vertical Mixing (CVMix) + Project}, + year = {2015}, + pages = {98 pp}, + institution = {NOAA GFDL} +} diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 63f8193b33..93696d3879 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -351,7 +351,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, tv%T, CS%diag) if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, tv%S, CS%diag) if (CS%id_e_preale > 0) then - call find_eta(h, tv, G, GV, US, eta_preale) + call find_eta(h, tv, G, GV, US, eta_preale, dZref=G%Z_ref) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif @@ -1304,7 +1304,7 @@ subroutine ALE_initThicknessToCoord( CS, G, GV, h ) integer :: i, j, k do j = G%jsd,G%jed ; do i = G%isd,G%ied - h(i,j,:) = GV%Z_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j) ) + h(i,j,:) = GV%Z_to_H * getStaticThickness( CS%regridCS, 0., G%bathyT(i,j)+G%Z_ref ) enddo ; enddo end subroutine ALE_initThicknessToCoord diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 1c6d9d4fe7..35dcdaa819 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -477,10 +477,10 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m CS%nk=ke ! Target resolution (for fixed coordinates) - allocate( CS%coordinateResolution(CS%nk) ); CS%coordinateResolution(:) = -1.E30 + allocate( CS%coordinateResolution(CS%nk), source=-1.E30 ) if (state_dependent(CS%regridding_scheme)) then ! Target values - allocate( CS%target_density(CS%nk+1) ); CS%target_density(:) = -1.E30*US%kg_m3_to_R + allocate( CS%target_density(CS%nk+1), source=-1.E30*US%kg_m3_to_R ) endif if (allocated(dz)) then @@ -799,7 +799,7 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ call build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h ) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_SIGMA_SHELF_ZSTAR) - call build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h ) + call build_zstar_grid( CS, G, GV, h, dzInterface ) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_SIGMA ) call build_sigma_grid( CS, G, GV, h, dzInterface ) @@ -880,21 +880,20 @@ subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) !$OMP parallel do default(shared) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, GV%Z_to_H*G%bathyT(i,j), h(i,j,:), dzInterface(i,j,:), msg ) + if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, h(i,j,:), dzInterface(i,j,:), msg ) enddo ; enddo end subroutine check_remapping_grid !> Check that the total thickness of new and old grids are consistent -subroutine check_grid_column( nk, depth, h, dzInterface, msg ) +subroutine check_grid_column( nk, h, dzInterface, msg ) integer, intent(in) :: nk !< Number of cells - real, intent(in) :: depth !< Depth of bottom [Z ~> m] or arbitrary units real, dimension(nk), intent(in) :: h !< Cell thicknesses [Z ~> m] or arbitrary units real, dimension(nk+1), intent(in) :: dzInterface !< Change in interface positions (same units as h) character(len=*), intent(in) :: msg !< Message to append to errors ! Local variables integer :: k - real :: eps, total_h_old, total_h_new, h_new, z_old, z_new + real :: eps, total_h_old, total_h_new, h_new eps =1. ; eps = epsilon(eps) @@ -904,13 +903,8 @@ subroutine check_grid_column( nk, depth, h, dzInterface, msg ) total_h_old = total_h_old + h(k) enddo - ! Integrate upwards for the interfaces consistent with the rest of MOM6 - z_old = - depth - if (depth == 0.) z_old = - total_h_old total_h_new = 0. do k = nk,1,-1 - z_old = z_old + h(k) ! Old interface position above layer k - z_new = z_old + dzInterface(k) ! New interface position based on dzInterface h_new = h(k) + ( dzInterface(k) - dzInterface(k+1) ) ! New thickness if (h_new<0.) then write(0,*) 'k,h,hnew=',k,h(k),h_new @@ -1082,7 +1076,7 @@ subroutine filtered_grid_motion( CS, nk, z_old, z_new, dz_g ) end subroutine filtered_grid_motion -!> Builds a z*-ccordinate grid with partial steps (Adcroft and Campin, 2004). +!> Builds a z*-coordinate grid with partial steps (Adcroft and Campin, 2004). !! z* is defined as !! z* = (z-eta)/(H+eta)*H s.t. z*=0 when z=eta and z*=-H when z=-H . subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) @@ -1118,8 +1112,8 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) cycle endif - ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%Z_to_H + ! Local depth (G%bathyT is positive downward) + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine water column thickness totalThickness = 0.0 @@ -1209,7 +1203,7 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) endif ! The rest of the model defines grids integrating up from the bottom - nominalDepth = G%bathyT(i,j)*GV%Z_to_H + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine water column height totalThickness = 0.0 @@ -1319,8 +1313,8 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel endif - ! Local depth (G%bathyT is positive) - nominalDepth = G%bathyT(i,j)*GV%Z_to_H + ! Local depth (G%bathyT is positive downward) + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine total water column thickness totalThickness = 0.0 @@ -1406,7 +1400,7 @@ end subroutine build_rho_grid !! density interpolated from the column profile and a clipping of depth for !! each interface to a fixed z* or p* grid. This should probably be (optionally?) !! changed to find the nearest location of the target density. -!! \remark { Based on Bleck, 2002: An oceanice general circulation model framed in +!! \remark { Based on Bleck, 2002: An ocean-ice general circulation model framed in !! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88. !! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 } subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_shelf_h ) @@ -1450,7 +1444,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - nominalDepth = G%bathyT(i,j) * GV%Z_to_H + nominalDepth = (G%bathyT(i,j)+G%Z_ref) * GV%Z_to_H if (ice_shelf) then totalThickness = 0.0 @@ -1575,7 +1569,9 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface [H ~> m or kg m-2] real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] - real :: depth + + ! Local variables + real :: depth ! Depth of the ocean relative to the mean sea surface height in thickness units [H ~> m or kg m-2] integer :: i, j, k, nz real :: h_neglect, h_neglect_edge @@ -1596,7 +1592,7 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 if (G%mask2dT(i,j)>0.) then - depth = G%bathyT(i,j) * GV%Z_to_H + depth = (G%bathyT(i,j)+G%Z_ref) * GV%Z_to_H z_col(1) = 0. ! Work downward rather than bottom up do K=1,nz z_col(K+1) = z_col(K) + h(i,j,k) @@ -1631,8 +1627,8 @@ end subroutine build_grid_SLight subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) type(regridding_CS), intent(in) :: CS !< Regridding control structure integer, intent(in) :: nk !< Number of layers in h_old - real, dimension(nk), intent(in) :: h_old !< Minium allowed thickness of h [H ~> m or kg m-2] - real, dimension(CS%nk+1), intent(inout) :: dz_int !< Minium allowed thickness of h [H ~> m or kg m-2] + real, dimension(nk), intent(in) :: h_old !< Minimum allowed thickness of h [H ~> m or kg m-2] + real, dimension(CS%nk+1), intent(inout) :: dz_int !< Minimum allowed thickness of h [H ~> m or kg m-2] ! Local variables integer :: k real :: h_new, eps, h_total, h_err @@ -1710,8 +1706,8 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) real :: total_height real :: delta_h real :: max_depth - real :: eta ! local elevation - real :: local_depth + real :: eta ! local elevation [H ~> m or kg m-2] + real :: local_depth ! The local ocean depth relative to mean sea level in thickness units [H ~> m or kg m-2] real :: x1, y1, x2, y2 real :: x, t @@ -1722,7 +1718,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) do i = G%isc-1,G%iec+1 ! Local depth - local_depth = G%bathyT(i,j)*GV%Z_to_H + local_depth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H ! Determine water column height total_height = 0.0 @@ -1769,7 +1765,7 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) endif enddo - ! Chnage in interface position + ! Change in interface position x = 0. ! Left boundary at x=0 dzInterface(i,j,1) = 0. do k = 2,nz @@ -1797,7 +1793,7 @@ subroutine inflate_vanished_layers_old( CS, G, GV, h ) ! objective is to make sure all layers are at least as thick as the minimum ! thickness allowed for regridding purposes (this parameter is set in the ! MOM_input file or defaulted to 1.0e-3). When layers are too thin, they -! are inflated up to the minmum thickness. +! are inflated up to the minimum thickness. !------------------------------------------------------------------------------ ! Arguments @@ -1901,7 +1897,7 @@ function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) ! Arguments integer, intent(in) :: nk !< Number of cells in source grid character(len=*), intent(in) :: coordMode !< A string indicating the coordinate mode. - !! See the documenttion for regrid_consts + !! See the documentation for regrid_consts !! for the recognized values. real, intent(in) :: maxDepth !< The range of the grid values in some modes real, intent(in) :: rhoLight !< The minimum value of the grid in RHO mode diff --git a/src/ALE/coord_adapt.F90 b/src/ALE/coord_adapt.F90 index 8fa4b09fc5..fe3864fc7a 100644 --- a/src/ALE/coord_adapt.F90 +++ b/src/ALE/coord_adapt.F90 @@ -144,7 +144,7 @@ subroutine build_adapt_column(CS, G, GV, US, tv, i, j, zInt, tInt, sInt, h, zNex zNext(nz+1) = zInt(i,j,nz+1) ! local depth for scaling diffusivity - depth = G%bathyT(i,j) * GV%Z_to_H + depth = (G%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ! initialize del2sigma and the thickness change response to it zero del2sigma(:) = 0.0 ; dh_d2s(:) = 0.0 diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 0c758fadaf..87019d46cf 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -373,7 +373,7 @@ function get_polynomial_coordinate( N, h, x_g, edge_values, ppoly_coefs, & real :: grad ! gradient during N-R iterations [A] integer :: i, k, iter ! loop indices integer :: k_found ! index of target cell - character(len=200) :: mesg + character(len=320) :: mesg logical :: use_2018_answers ! If true use older, less acccurate expressions. eps = NR_OFFSET diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 475e5a423f..4072cf54a0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -41,7 +41,7 @@ module MOM use MOM_io, only : slasher, file_exists, MOM_read_data use MOM_obsolete_params, only : find_obsolete_params use MOM_restart, only : register_restart_field, register_restart_pair -use MOM_restart, only : query_initialized, save_restart +use MOM_restart, only : query_initialized, save_restart, restart_registry_lock use MOM_restart, only : restart_init, is_new_run, determine_is_new_run, MOM_restart_CS use MOM_spatial_means, only : global_mass_integral use MOM_time_manager, only : time_type, real_to_time, time_type_to_real, operator(+) @@ -213,6 +213,8 @@ module MOM real :: t_dyn_rel_adv !< The time of the dynamics relative to tracer advection and lateral mixing !! [T ~> s], or equivalently the elapsed time since advectively updating the !! tracers. t_dyn_rel_adv is invariably positive and may span multiple coupling timesteps. + integer :: n_dyn_steps_in_adv !< The number of dynamics time steps that contributed to uhtr + !! and vhtr since the last time tracer advection occured. real :: t_dyn_rel_thermo !< The time of the dynamics relative to diabatic processes and remapping !! [T ~> s]. t_dyn_rel_thermo can be negative or positive depending on whether !! the diabatic processes are applied before or after the dynamics and may span @@ -234,6 +236,9 @@ module MOM logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical is set by calling the !! function useRegridding() from the MOM_regridding module. + logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction + !! updates occur first in directionally split parts of the calculation. + real :: first_dir_restart = -1.0 !< A real copy of G%first_direction for use in restart files logical :: offline_tracer_mode = .false. !< If true, step_offline() is called instead of step_MOM(). !! This is intended for running MOM6 in offline tracer mode @@ -440,7 +445,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS type(surface), target, intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_int_in !< time interval covered by this run segment [s]. - type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM type(Wave_parameters_CS), & optional, pointer :: Waves !< An optional pointer to a wave property CS logical, optional, intent(in) :: do_dynamics !< Present and false, do not do updates due @@ -855,7 +860,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0) + call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0, dZref=G%Z_ref) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -990,7 +995,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & real, intent(in) :: bbl_time_int !< time interval over which updates to the !! bottom boundary layer properties will apply [T ~> s], !! or zero not to update the properties. - type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + type(MOM_control_struct), intent(inout), target :: CS !< control structure from initialize_MOM type(time_type), intent(in) :: Time_local !< End time of a segment, as a time type type(wave_parameters_CS), & optional, pointer :: Waves !< Container for wave related parameters; the @@ -1142,6 +1147,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & ! Advance the dynamics time by dt. CS%t_dyn_rel_adv = CS%t_dyn_rel_adv + dt + CS%n_dyn_steps_in_adv = CS%n_dyn_steps_in_adv + 1 + if (CS%alternate_first_direction) then + call set_first_direction(G, MODULO(G%first_direction+1,2)) + CS%first_dir_restart = real(G%first_direction) + endif CS%t_dyn_rel_thermo = CS%t_dyn_rel_thermo + dt if (abs(CS%t_dyn_rel_thermo) < 1e-6*dt) CS%t_dyn_rel_thermo = 0.0 CS%t_dyn_rel_diag = CS%t_dyn_rel_diag + dt @@ -1173,6 +1183,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) !! of the time step. type(group_pass_type) :: pass_T_S integer :: halo_sz ! The size of a halo where data must be valid. + logical :: x_first ! If true, advect tracers first in the x-direction, then y. logical :: showCallTree showCallTree = callTree_showQuery() @@ -1194,8 +1205,16 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) call enable_averages(CS%t_dyn_rel_adv, Time_local, CS%diag) + if (CS%alternate_first_direction) then + ! This calculation of the value of G%first_direction from the start of the accumulation of + ! mass transports for use by the tracers is the equivalent to adding 2*n_dyn_steps before + ! subtracting n_dyn_steps so that the mod will be taken of a non-negative number. + x_first = (MODULO(G%first_direction+CS%n_dyn_steps_in_adv,2) == 0) + else + x_first = (MODULO(G%first_direction,2) == 0) + endif 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) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first) 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)") @@ -1218,6 +1237,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) CS%uhtr(:,:,:) = 0.0 CS%vhtr(:,:,:) = 0.0 + CS%n_dyn_steps_in_adv = 0 CS%t_dyn_rel_adv = 0.0 call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) @@ -1281,7 +1301,13 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call enable_averages(dtdia, Time_end_thermo, CS%diag) if (associated(CS%odaCS)) then - call apply_oda_tracer_increments(US%T_to_s*dtdia, G, GV, tv, h, CS%odaCS) + if (CS%debug) then + call MOM_thermo_chksum("Pre-oda ", tv, G, US, haloshift=0) + endif + call apply_oda_tracer_increments(US%T_to_s*dtdia, Time_end_thermo, G, GV, tv, h, CS%odaCS) + if (CS%debug) then + call MOM_thermo_chksum("Post-oda ", tv, G, US, haloshift=0) + endif endif if (associated(fluxes%p_surf) .or. associated(fluxes%p_surf_full)) then @@ -1441,7 +1467,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type real, intent(in) :: time_interval !< time interval - type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM ! Local pointers type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing @@ -1639,7 +1665,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse type(directories), intent(out) :: dirs !< structure with directory paths - type(MOM_control_struct), pointer :: CS !< pointer set in this routine to MOM control structure + type(MOM_control_struct), intent(inout), target :: CS !< pointer set in this routine to MOM control structure type(MOM_restart_CS), pointer :: restart_CSp !< pointer set in this routine to the !! restart control structure that will !! be used for MOM. @@ -1740,13 +1766,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(ocean_internal_state) :: MOM_internal_state character(len=200) :: area_varname, ice_shelf_file, inputdir, filename - if (associated(CS)) then - call MOM_error(WARNING, "initialize_MOM called with an associated "// & - "control structure.") - return - endif - allocate(CS) - CS%Time => Time id_clock_init = cpu_clock_id('Ocean Initialization', grain=CLOCK_SUBCOMPONENT) @@ -2000,6 +2019,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "in parts of the code that use directionally split "//& "updates, with even numbers (or 0) used for x- first "//& "and odd numbers used for y-first.", default=0) + call get_param(param_file, "MOM", "ALTERNATE_FIRST_DIRECTION", CS%alternate_first_direction, & + "If true, after every dynamic timestep alternate whether the x- or y- "//& + "direction updates occur first in directionally split parts of the calculation. "//& + "If this is true, FIRST_DIRECTION applies at the start of a new run or if "//& + "the next first direction can not be found in the restart file.", default=.false.) call get_param(param_file, "MOM", "CHECK_BAD_SURFACE_VALS", CS%check_bad_sfc_vals, & "If true, check the surface state for ridiculous values.", & @@ -2121,7 +2145,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Swap axes for quarter and 3-quarter turns if (CS%rotate_index) then allocate(CS%G) - call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns) + call clone_MOM_domain(G_in%Domain, CS%G%Domain, turns=turns, & + domain_name="MOM_rot") first_direction = modulo(first_direction + turns, 2) else CS%G => G_in @@ -2162,8 +2187,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(OBC_in)) then ! TODO: General OBC index rotations is not yet supported. if (modulo(turns, 4) /= 1) & - call MOM_error(FATAL, "OBC index rotation of 180 and 270 degrees is " & - // "not yet unsupported.") + call MOM_error(FATAL, "OBC index rotation of 180 and 270 degrees is not yet supported.") allocate(CS%OBC) call rotate_OBC_config(OBC_in, dG_in, CS%OBC, dG, turns) endif @@ -2184,8 +2208,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call MOM_timing_init(CS) - if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, US, CS%OBC) - call tracer_registry_init(param_file, CS%tracer_Reg) ! Allocate and initialize space for the primary time-varying MOM variables. @@ -2239,31 +2261,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) endif - ! NOTE: register_temp_salt_segments includes allocation of tracer fields - ! along segments. Bit reproducibility requires that MOM_initialize_state - ! be called on the input index map, so we must setup both OBC and OBC_in. - ! - ! XXX: This call on OBC_in allocates the tracer fields on the unrotated - ! grid, but also incorrectly stores a pointer to a tracer_type for the - ! rotated registry (e.g. segment%tr_reg%Tr(n)%Tr) from CS%tracer_reg. - ! - ! While incorrect and potentially dangerous, it does not seem that this - ! pointer is used during initialization, so we leave it for now. - if (CS%rotate_index .and. associated(OBC_in)) & - call register_temp_salt_segments(GV, OBC_in, CS%tracer_Reg, param_file) - if (associated(CS%OBC)) & - call register_temp_salt_segments(GV, CS%OBC, CS%tracer_Reg, param_file) - endif - if (use_frazil) then - allocate(CS%tv%frazil(isd:ied,jsd:jed)) ; CS%tv%frazil(:,:) = 0.0 - endif - if (bound_salinity) then - allocate(CS%tv%salt_deficit(isd:ied,jsd:jed)) ; CS%tv%salt_deficit(:,:) = 0.0 endif - if (bulkmixedlayer .or. use_temperature) then - allocate(CS%Hml(isd:ied,jsd:jed)) ; CS%Hml(:,:) = 0.0 - endif + if (use_frazil) allocate(CS%tv%frazil(isd:ied,jsd:jed), source=0.0) + if (bound_salinity) allocate(CS%tv%salt_deficit(isd:ied,jsd:jed), source=0.0) + + if (bulkmixedlayer .or. use_temperature) allocate(CS%Hml(isd:ied,jsd:jed), source=0.0) if (bulkmixedlayer) then GV%nkml = nkml ; GV%nk_rho_varies = nkml + nkbl @@ -2277,10 +2280,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ALLOC_(CS%uhtr(IsdB:IedB,jsd:jed,nz)) ; CS%uhtr(:,:,:) = 0.0 ALLOC_(CS%vhtr(isd:ied,JsdB:JedB,nz)) ; CS%vhtr(:,:,:) = 0.0 CS%t_dyn_rel_adv = 0.0 ; CS%t_dyn_rel_thermo = 0.0 ; CS%t_dyn_rel_diag = 0.0 + CS%n_dyn_steps_in_adv = 0 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 + allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(CS%v_prev(isd:ied,JsdB:JedB,nz), source=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) @@ -2300,13 +2304,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%CDp%uh => CS%uh ; CS%CDp%vh => CS%vh - if (CS%interp_p_surf) then - allocate(CS%p_surf_prev(isd:ied,jsd:jed)) ; CS%p_surf_prev(:,:) = 0.0 - endif + if (CS%interp_p_surf) allocate(CS%p_surf_prev(isd:ied,jsd:jed), source=0.0) ALLOC_(CS%ssh_rint(isd:ied,jsd:jed)) ; CS%ssh_rint(:,:) = 0.0 ALLOC_(CS%ave_ssh_ibc(isd:ied,jsd:jed)) ; CS%ave_ssh_ibc(:,:) = 0.0 - ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 + ALLOC_(CS%eta_av_bc(isd:ied,jsd:jed)) ; CS%eta_av_bc(:,:) = 0.0 ! -G%Z_ref CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0 ! Use the Wright equation of state by default, unless otherwise specified @@ -2314,9 +2316,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! initialization routine for tv. if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state, US) if (use_temperature) then - allocate(CS%tv%TempxPmE(isd:ied,jsd:jed)) ; CS%tv%TempxPmE(:,:) = 0.0 + allocate(CS%tv%TempxPmE(isd:ied,jsd:jed), source=0.0) if (use_geothermal) then - allocate(CS%tv%internal_heat(isd:ied,jsd:jed)) ; CS%tv%internal_heat(:,:) = 0.0 + allocate(CS%tv%internal_heat(isd:ied,jsd:jed), source=0.0) endif endif call callTree_waypoint("state variables allocated (initialize_MOM)") @@ -2346,11 +2348,38 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call mixedlayer_restrat_register_restarts(dG%HI, param_file, & CS%mixedlayer_restrat_CSp, restart_CSp) - if (associated(CS%OBC)) & + if (CS%rotate_index .and. associated(OBC_in) .and. use_temperature) then + ! NOTE: register_temp_salt_segments includes allocation of tracer fields + ! along segments. Bit reproducibility requires that MOM_initialize_state + ! be called on the input index map, so we must setup both OBC and OBC_in. + ! + ! XXX: This call on OBC_in allocates the tracer fields on the unrotated + ! grid, but also incorrectly stores a pointer to a tracer_type for the + ! rotated registry (e.g. segment%tr_reg%Tr(n)%Tr) from CS%tracer_reg. + ! + ! While incorrect and potentially dangerous, it does not seem that this + ! pointer is used during initialization, so we leave it for now. + call register_temp_salt_segments(GV, OBC_in, CS%tracer_Reg, param_file) + endif + + if (associated(CS%OBC)) then + ! Set up remaining information about open boundary conditions that is needed for OBCs. + call call_OBC_register(param_file, CS%update_OBC_CSp, US, CS%OBC, CS%tracer_Reg) + !### Package specific changes to OBCs need to go here? + + ! This is the equivalent to 2 calls to register_segment_tracer (per segment), which + ! could occur with the call to update_OBC_data or after the main initialization. + if (use_temperature) & + call register_temp_salt_segments(GV, CS%OBC, CS%tracer_Reg, param_file) + + ! This needs the number of tracers and to have called any code that sets whether + ! reservoirs are used. call open_boundary_register_restarts(dg%HI, GV, CS%OBC, CS%tracer_Reg, & param_file, restart_CSp, use_temperature) + endif call callTree_waypoint("restart registration complete (initialize_MOM)") + call restart_registry_lock(restart_CSp) ! Shift from using the temporary dynamic grid type to using the final ! (potentially static) ocean-specific grid type. @@ -2389,6 +2418,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Set a few remaining fields that are specific to the ocean grid type. call set_first_direction(G, first_direction) + CS%first_dir_restart = real(G%first_direction) ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. G%symmetric) then call clone_MOM_domain(G%Domain, G%Domain_aux, symmetric=.false.) @@ -2400,18 +2430,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%rotate_index) then G_in%ke = GV%ke - allocate(u_in(G_in%IsdB:G_in%IedB, G_in%jsd:G_in%jed, nz)) - allocate(v_in(G_in%isd:G_in%ied, G_in%JsdB:G_in%JedB, nz)) - allocate(h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz)) - u_in(:,:,:) = 0.0 - v_in(:,:,:) = 0.0 - h_in(:,:,:) = GV%Angstrom_H + allocate(u_in(G_in%IsdB:G_in%IedB, G_in%jsd:G_in%jed, nz), source=0.0) + allocate(v_in(G_in%isd:G_in%ied, G_in%JsdB:G_in%JedB, nz), source=0.0) + allocate(h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=GV%Angstrom_H) if (use_temperature) then - allocate(T_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz)) - allocate(S_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz)) - T_in(:,:,:) = 0.0 - S_in(:,:,:) = 0.0 + allocate(T_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=0.0) + allocate(S_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=0.0) CS%tv%T => T_in CS%tv%S => S_in @@ -2422,10 +2447,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! when using an ice shelf. Passing the ice shelf diagnostics CS from MOM ! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr) - allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed)) - frac_shelf_in(:,:) = 0.0 - allocate(CS%frac_shelf_h(isd:ied, jsd:jed)) - CS%frac_shelf_h(:,:) = 0.0 + allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) + allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) ! MOM_initialize_state is using the unrotated metric call rotate_array(CS%frac_shelf_h, -turns, frac_shelf_in) @@ -2444,11 +2467,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%tv%S => CS%S endif + ! Reset the first direction if it was found in a restart file. + if (CS%first_dir_restart > -0.5) & + call set_first_direction(G, NINT(CS%first_dir_restart)) + ! Store the first direction for the next time a restart file is written. + CS%first_dir_restart = real(G%first_direction) + call rotate_initial_state(u_in, v_in, h_in, T_in, S_in, use_temperature, & turns, CS%u, CS%v, CS%h, CS%T, CS%S) if (associated(sponge_in_CSp)) then - ! TODO: Implementation and testing of non-ALE spong rotation + ! TODO: Implementation and testing of non-ALE sponge rotation call MOM_error(FATAL, "Index rotation of non-ALE sponge is not yet implemented.") endif @@ -2473,8 +2502,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else if (use_ice_shelf) then call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr) - allocate(CS%frac_shelf_h(isd:ied, jsd:jed)) - CS%frac_shelf_h(:,:) = 0.0 + allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) 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, & @@ -2488,19 +2516,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif if (use_ice_shelf .and. CS%debug) & - call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, & - haloshift=0) + call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0) call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") -! ! Need this after MOM_initialize_state for DOME OBC stuff. -! if (associated(CS%OBC)) & -! call open_boundary_register_restarts(G%HI, GV, CS%OBC, CS%tracer_Reg, & -! param_file, restart_CSp, use_temperature) - -! call callTree_waypoint("restart registration complete (initialize_MOM)") - ! From this point, there may be pointers being set, so the final grid type ! that will persist throughout the run has to be used. @@ -2619,7 +2639,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & 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 + allocate(eta(SZI_(G),SZJ_(G)), source=0.0) call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & G, GV, US, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & @@ -2722,7 +2742,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & - tv=CS%tv, x_before_y = (MOD(first_direction,2)==0), debug=CS%debug ) + tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug ) call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) endif @@ -2798,9 +2818,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then if (CS%split) then - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0, dZref=G%Z_ref) else - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0, dZref=G%Z_ref) endif endif if (CS%split) deallocate(eta) @@ -2816,7 +2836,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & (LEN_TRIM(dirs%input_filename) == 1)) if (CS%ensemble_ocean) then - call init_oda(Time, G, GV, CS%odaCS) + call init_oda(Time, G, GV, CS%diag, CS%odaCS) endif ! initialize stochastic physics @@ -2835,7 +2855,7 @@ end subroutine initialize_MOM subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths - type(MOM_control_struct), pointer :: CS !< pointer to MOM control structure + type(MOM_control_struct), intent(inout) :: CS !< MOM control structure type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control !! structure that will be used for MOM. ! Local variables @@ -2862,8 +2882,9 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) if (CS%write_IC) then allocate(restart_CSp_tmp) restart_CSp_tmp = restart_CSp + call restart_registry_lock(restart_CSp_tmp, unlocked=.true.) allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1)) - call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0) + call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0, dZref=G%Z_ref) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & "Interface heights", "meter", z_grid='i') ! NOTE: write_ic=.true. routes routine to fms2 IO write_initial_conditions interface @@ -3011,6 +3032,8 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) "Density unit conversion factor", "R m3 kg-1") call register_restart_field(US%J_kg_to_Q_restart, "J_kg_to_Q", .false., restart_CSp, & "Heat content unit conversion factor.", units="Q kg J-1") + call register_restart_field(CS%first_dir_restart, "First_direction", .false., restart_CSp, & + "Indicator of the first direction in split calculations.", "nondim") end subroutine set_restart_fields @@ -3061,7 +3084,7 @@ end subroutine adjust_ssh_for_p_atm !! setting the appropriate fields in sfc_state. Unused fields !! are set to NULL or are unallocated. subroutine extract_surface_state(CS, sfc_state_in) - type(MOM_control_struct), pointer :: CS !< Master MOM control structure + type(MOM_control_struct), intent(inout), target :: CS !< Master MOM control structure type(surface), target, intent(inout) :: sfc_state_in !< transparent ocean surface state !! structure shared with the calling routine !! data in this structure is intent out. @@ -3412,10 +3435,10 @@ subroutine extract_surface_state(CS, sfc_state_in) numberOfErrors=0 ! count number of errors do j=js,je ; do i=is,ie if (G%mask2dT(i,j)>0.) then - localError = sfc_state%sea_lev(i,j) <= -G%bathyT(i,j) & + localError = sfc_state%sea_lev(i,j) <= -G%bathyT(i,j) - G%Z_ref & .or. sfc_state%sea_lev(i,j) >= CS%bad_val_ssh_max & .or. sfc_state%sea_lev(i,j) <= -CS%bad_val_ssh_max & - .or. sfc_state%sea_lev(i,j) + G%bathyT(i,j) < CS%bad_val_col_thick + .or. sfc_state%sea_lev(i,j) + G%bathyT(i,j) + G%Z_ref < CS%bad_val_col_thick if (use_temperature) localError = localError & .or. sfc_state%SSS(i,j)<0. & .or. sfc_state%SSS(i,j)>=CS%bad_val_sss_max & @@ -3431,7 +3454,7 @@ subroutine extract_surface_state(CS, sfc_state_in) '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=',CS%US%Z_to_m*G%bathyT(i,j), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3440,7 +3463,7 @@ subroutine extract_surface_state(CS, sfc_state_in) '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=',CS%US%Z_to_m*G%bathyT(i,j), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif @@ -3488,7 +3511,7 @@ end subroutine rotate_initial_state !> Return true if all phases of step_MOM are at the same point in time. function MOM_state_is_synchronized(CS, adv_dyn) result(in_synch) - type(MOM_control_struct), pointer :: CS !< MOM control structure + type(MOM_control_struct), intent(inout) :: CS !< MOM control structure logical, optional, intent(in) :: adv_dyn !< If present and true, only check !! whether the advection is up-to-date with !! the dynamics. @@ -3509,7 +3532,7 @@ end function MOM_state_is_synchronized !> This subroutine offers access to values or pointers to other types from within !! the MOM_control_struct, allowing the MOM_control_struct to be opaque. subroutine get_MOM_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp) - type(MOM_control_struct), pointer :: CS !< MOM control structure + type(MOM_control_struct), intent(inout), target :: CS !< MOM control structure type(ocean_grid_type), optional, pointer :: G !< structure containing metrics and grid info type(verticalGrid_type), optional, pointer :: GV !< structure containing vertical grid info type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type @@ -3528,7 +3551,7 @@ end subroutine get_MOM_state_elements !> Find the global integrals of various quantities. subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only) - type(MOM_control_struct), pointer :: CS !< MOM control structure + type(MOM_control_struct), intent(inout) :: CS !< MOM control structure real, optional, intent(out) :: heat !< The globally integrated integrated ocean heat [J]. real, optional, intent(out) :: salt !< The globally integrated integrated ocean salt [kg]. real, optional, intent(out) :: mass !< The globally integrated integrated ocean mass [kg]. @@ -3545,7 +3568,7 @@ end subroutine get_ocean_stocks !> End of ocean model, including memory deallocation subroutine MOM_end(CS) - type(MOM_control_struct), pointer :: CS !< MOM control structure + type(MOM_control_struct), intent(inout) :: CS !< MOM control structure call MOM_sum_output_end(CS%sum_output_CSp) @@ -3621,7 +3644,6 @@ subroutine MOM_end(CS) if (associated(CS%update_OBC_CSp)) call OBC_register_end(CS%update_OBC_CSp) call verticalGridEnd(CS%GV) - call unit_scaling_end(CS%US) call MOM_grid_end(CS%G) if (CS%debug .or. CS%G%symmetric) & @@ -3630,9 +3652,11 @@ subroutine MOM_end(CS) if (CS%rotate_index) & call deallocate_MOM_domain(CS%G%Domain) - call deallocate_MOM_domain(CS%G_in%domain) + ! The MPP domains may be needed by an external coupler, so use `cursory`. + ! TODO: This may create a domain memory leak, and needs investigation. + call deallocate_MOM_domain(CS%G_in%domain, cursory=.true.) - deallocate(CS) + call unit_scaling_end(CS%US) end subroutine MOM_end !> \namespace mom diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 89a7a1faff..23e58272ed 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -90,10 +90,9 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv [H ~> m or kg m-2], with any tidal - !! contributions or compressibility compensation. + !! [L2 T-2 H-1 ~> m4 s-2 kg-1]. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The total column mass used to + !! calculate PFu and PFv [H ~> kg m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: p ! Interface pressure [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & @@ -301,7 +300,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Find and add the tidal geopotential anomaly. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth + SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref enddo ; enddo call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) !$OMP parallel do default(shared) @@ -430,15 +429,16 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm !! or atmosphere-ocean interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(out) :: pbce !< The baroclinic pressure !! anomaly in each layer due to eta anomalies - !! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The bottom mass used to - !! calculate PFu and PFv [H ~> m or kg m-2], with any - !! tidal contributions or compressibility compensation. + !! [L2 T-2 H-1 ~> m s-2]. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The sea-surface height used to + !! calculate PFu and PFv [H ~> m], with any + !! tidal contributions. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in depth units [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)) :: & e_tidal, & ! The bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. + SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. dM ! The barotropic adjustment to the Montgomery potential to ! account for a reduced gravity model [L2 T-2 ~> m2 s-2]. real, dimension(SZI_(G)) :: & @@ -451,7 +451,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm dpa, & ! The change in pressure anomaly between the top and bottom ! of a layer [R L2 T-2 ~> Pa]. intz_dpa ! The vertical integral in depth of the pressure anomaly less the - ! pressure anomaly at the top of the layer [H R L2 T-2 ~> m Pa or kg m-2 Pa]. + ! pressure anomaly at the top of the layer [H R L2 T-2 ~> m Pa]. real, dimension(SZIB_(G),SZJ_(G)) :: & intx_pa, & ! The zonal integral of the pressure anomaly along the interface ! atop a layer, divided by the grid spacing [R L2 T-2 ~> Pa]. @@ -485,7 +485,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real :: Tl(5) ! copy and T in local stencil [degC] real :: mn_T ! mean of T in local stencil [degC] - real :: mn_T2 ! mean of T**2 in local stencil [degC] + real :: mn_T2 ! mean of T**2 in local stencil [degC2] real :: hl(5) ! Copy of local stencil of H [H ~> m] real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] real, parameter :: C1_6 = 1.0/6.0 @@ -565,13 +565,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm !$OMP parallel do default(shared) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 - e(i,j,1) = -G%bathyT(i,j) + SSH(i,j) = -G%bathyT(i,j) - G%Z_ref enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z + SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. @@ -637,13 +637,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm tv%eqn_of_state, EOSdom) endif do i=Isq,Ieq+1 - dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * e(i,j,1) + dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * rho_in_situ(i)) * (e(i,j,1) - G%Z_ref) 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) * (G_Rho0 * GV%Rlay(1)) * e(i,j,1) + dM(i,j) = (CS%GFS_scale - 1.0) * (G_Rho0 * GV%Rlay(1)) * (e(i,j,1) - G%Z_ref) enddo ; enddo endif endif @@ -667,12 +667,12 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm if (use_p_atm) then !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + p_atm(i,j) + pa(i,j) = (rho_ref*GV%g_Earth)*(e(i,j,1) - G%Z_ref) + p_atm(i,j) enddo ; enddo else !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - pa(i,j) = (rho_ref*GV%g_Earth)*e(i,j,1) + pa(i,j) = (rho_ref*GV%g_Earth)*(e(i,j,1) - G%Z_ref) enddo ; enddo endif !$OMP parallel do default(shared) @@ -700,17 +700,17 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & useMassWghtInterp=CS%useMassWghtInterp, & - use_inaccurate_form=CS%use_inaccurate_pgf_rho_anom) + use_inaccurate_form=CS%use_inaccurate_pgf_rho_anom, Z_0p=G%Z_ref) elseif ( CS%Recon_Scheme == 2 ) then call int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, & - useMassWghtInterp=CS%useMassWghtInterp) + useMassWghtInterp=CS%useMassWghtInterp, Z_0p=G%Z_ref) endif else call int_density_dz(tv_tmp%T(:,:,k), tv_tmp%S(:,:,k), e(:,:,K), e(:,:,K+1), & rho_ref, CS%Rho0, GV%g_Earth, G%HI, tv%eqn_of_state, US, dpa, & - intz_dpa, intx_dpa, inty_dpa, G%bathyT, dz_neglect, CS%useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, G%bathyT, dz_neglect, CS%useMassWghtInterp, Z_0p=G%Z_ref) endif !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index ac5cb6c84c..05e68aef12 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -77,8 +77,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb optional, intent(out) :: pbce !< The baroclinic pressure anomaly in !! each layer due to free surface height anomalies, !! [L2 T-2 H-1 ~> m s-2 or m4 kg-1 s-2]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< Free surface height [H ~> kg m-1]. - + real, dimension(SZI_(G),SZJ_(G)), optional, intent(out) :: eta !< The total column mass used to calculate + !! PFu and PFv [H ~> kg m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. @@ -104,7 +104,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb SSH, & ! The sea surface height anomaly, in depth units [Z ~> m]. e_tidal, & ! Bottom geopotential anomaly due to tidal forces from ! astronomical sources and self-attraction and loading [Z ~> m]. - geopot_bot ! Bottom geopotential relative to time-mean sea level, + geopot_bot ! Bottom geopotential relative to a temporally fixed reference value, ! including any tidal contributions [L2 T-2 ~> m2 s-2]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -183,7 +183,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb ! of self-attraction and loading. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - SSH(i,j) = -G%bathyT(i,j) + SSH(i,j) = -G%bathyT(i,j) - G%Z_ref enddo ; enddo if (use_EOS) then !$OMP parallel do default(shared) @@ -393,6 +393,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! the deepest variable density near-surface layer [R ~> kg m-3]. real :: h_star(SZI_(G),SZJ_(G)) ! Layer thickness after compensation ! for compressibility [Z ~> m]. + real :: SSH(SZI_(G),SZJ_(G)) ! The sea surface height anomaly, in depth units [Z ~> m]. real :: e_tidal(SZI_(G),SZJ_(G)) ! Bottom geopotential anomaly due to tidal ! forces from astronomical sources and self- ! attraction and loading, in depth units [Z ~> m]. @@ -444,12 +445,12 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, ! barotropic tides. !$OMP parallel do default(shared) do j=Jsq,Jeq+1 - do i=Isq,Ieq+1 ; e(i,j,1) = -G%bathyT(i,j) ; enddo + do i=Isq,Ieq+1 ; SSH(i,j) = -G%bathyT(i,j) - G%Z_ref ; enddo do k=1,nz ; do i=Isq,Ieq+1 - e(i,j,1) = e(i,j,1) + h(i,j,k)*GV%H_to_Z + SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, e(:,:,1), e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) endif ! Here layer interface heights, e, are calculated. @@ -664,7 +665,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do j=Jsq,Jeq+1 do i=Isq,Ieq+1 Ihtot(i) = GV%H_to_Z / ((e(i,j,1)-e(i,j,nz+1)) + z_neglect) - press(i) = -Rho0xG*e(i,j,1) + press(i) = -Rho0xG*(e(i,j,1) - G%Z_ref) enddo call calculate_density(tv%T(:,j,1), tv%S(:,j,1), press, rho_in_situ, & tv%eqn_of_state, EOSdom) @@ -673,7 +674,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) enddo do k=2,nz do i=Isq,Ieq+1 - press(i) = -Rho0xG*e(i,j,K) + press(i) = -Rho0xG*(e(i,j,K) - G%Z_ref) T_int(i) = 0.5*(tv%T(i,j,k-1)+tv%T(i,j,k)) S_int(i) = 0.5*(tv%S(i,j,k-1)+tv%S(i,j,k)) enddo diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 51f9a5cb85..abc2e228f6 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -685,6 +685,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, integer :: isv, iev, jsv, jev ! The valid array size at the end of a step. integer :: stencil ! The stencil size of the algorithm, often 1 or 2. integer :: isvf, ievf, jsvf, jevf, num_cycles + integer :: err_count ! A counter to limit the volume of error messages written to stdout. integer :: i, j, k, n integer :: is, ie, js, je, nz, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -700,6 +701,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, 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 h_neglect = GV%H_subroundoff + err_count = 0 Idt = 1.0 / dt accel_underflow = CS%vel_underflow * Idt @@ -2356,13 +2358,21 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (GV%Boussinesq) then do j=js,je ; do i=is,ie - if (eta(i,j) < -GV%Z_to_H*G%bathyT(i,j)) & - call MOM_error(WARNING, "btstep: eta has dropped below bathyT.") + if ((eta(i,j) < -GV%Z_to_H*G%bathyT(i,j)) .and. (G%mask2dT(i,j) > 0.0)) then + write(mesg,'(ES24.16," vs. ",ES24.16, " at ", ES12.4, ES12.4, i7, i7)') GV%H_to_m*eta(i,j), & + -US%Z_to_m*G%bathyT(i,j), G%geoLonT(i,j), G%geoLatT(i,j), i + G%isd_global, j + G%jsd_global + if (err_count < 2) & + call MOM_error(WARNING, "btstep: eta has dropped below bathyT: "//trim(mesg), all_print=.true.) + err_count = err_count + 1 + endif enddo ; enddo else do j=js,je ; do i=is,ie - if (eta(i,j) < 0.0) & - call MOM_error(WARNING, "btstep: negative eta in a non-Boussinesq barotropic solver.") + if (eta(i,j) < 0.0) then + if (err_count < 2) & + call MOM_error(WARNING, "btstep: negative eta in a non-Boussinesq barotropic solver.", all_print=.true.) + err_count = err_count + 1 + endif enddo ; enddo endif @@ -2566,7 +2576,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%id_vaccel > 0) call post_data(CS%id_vaccel, v_accel_bt(isd:ied,JsdB:JedB), CS%diag) if (CS%id_eta_cor > 0) call post_data(CS%id_eta_cor, CS%eta_cor, CS%diag) - if (CS%id_eta_bt > 0) call post_data(CS%id_eta_bt, eta_out, CS%diag) + if (CS%id_eta_bt > 0) call post_data(CS%id_eta_bt, eta_out, CS%diag) ! - G%Z_ref? if (CS%id_gtotn > 0) call post_data(CS%id_gtotn, gtot_N(isd:ied,jsd:jed), CS%diag) if (CS%id_gtots > 0) call post_data(CS%id_gtots, gtot_S(isd:ied,jsd:jed), CS%diag) if (CS%id_gtote > 0) call post_data(CS%id_gtote, gtot_E(isd:ied,jsd:jed), CS%diag) @@ -2685,6 +2695,16 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ADp%diag_hv(i,J,k) = BT_cont%h_v(i,J,k) enddo ; enddo ; enddo endif + if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + do k=1,nz ; do j=js,je ; do I=is-1,ie + ADp%visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + enddo ; enddo ; enddo + endif + if (present(ADp) .and. (associated(ADp%visc_rem_u))) then + do k=1,nz ; do J=js-1,je ; do i=is,ie + ADp%visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + enddo ; enddo ; enddo + endif if (G%nonblocking_updates) then if (find_etaav) call complete_group_pass(CS%pass_etaav, G%Domain) @@ -3073,17 +3093,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B endif if (.not. BT_OBC%is_alloced) then - allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%Cg_u(:,:) = 0.0 - allocate(BT_OBC%H_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%H_u(:,:) = 0.0 - allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%uhbt(:,:) = 0.0 - allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%ubt_outer(:,:) = 0.0 - allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%eta_outer_u(:,:) = 0.0 - - allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%Cg_v(:,:) = 0.0 - allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%H_v(:,:) = 0.0 - allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%vhbt(:,:) = 0.0 - allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%vbt_outer(:,:) = 0.0 - allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%eta_outer_v(:,:)=0.0 + allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%H_u(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw), source=0.0) + + allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw), source=0.0) BT_OBC%is_alloced = .true. call create_group_pass(BT_OBC%pass_uv, BT_OBC%ubt_outer, BT_OBC%vbt_outer, BT_Domain) call create_group_pass(BT_OBC%pass_uhvh, BT_OBC%uhbt, BT_OBC%vhbt, BT_Domain) @@ -3139,7 +3159,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j) - BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) + BT_OBC%eta_outer_u(I,j) = segment%eta(I,j) + G%Z_ref*GV%Z_to_H enddo ; enddo endif enddo @@ -3193,7 +3213,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J) - BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) + BT_OBC%eta_outer_v(i,J) = segment%eta(i,J) + G%Z_ref*GV%Z_to_H enddo ; enddo endif enddo @@ -3268,8 +3288,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) real :: Rh ! A ratio of summed thicknesses, nondim. real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity and real :: e_v(SZI_(G),SZK_(GV)+1) ! v-velocity points [H ~> m or kg m-2]. - real :: D_shallow_u(SZI_(G)) ! The shallower of the adjacent depths [H ~> m or kg m-2]. - real :: D_shallow_v(SZIB_(G))! The shallower of the adjacent depths [H ~> m or kg m-2]. + real :: D_shallow_u(SZI_(G)) ! The height of the shallower of the adjacent bathymetric depths + ! around a u-point (positive upward) [H ~> m or kg m-2] + real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths + ! around a v-point (positive upward) [H ~> m or kg m-2] real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2]. real :: Ihtot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1]. @@ -4124,7 +4146,7 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec hs = 1 ; if (present(halo)) hs = max(halo,0) -!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,CS,Datu,Datv,add_max) & +!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,G,CS,Datu,Datv,add_max) & !$OMP private(H1,H2) if (present(eta)) then ! The use of harmonic mean thicknesses ensure positive definiteness. @@ -4163,31 +4185,27 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, eta, halo, add_max) !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * & - (max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + add_max) + max(max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * & - (max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + add_max) + max(max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) enddo ; enddo else !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I, j) = 0.0 - !Would be "if (G%mask2dCu(I,j)>0.) &" is G was valid on BT domain - if (CS%bathyT(i+1,j)+CS%bathyT(i,j)>0.) & - Datu(I,j) = 2.0*CS%dy_Cu(I,j) * GV%Z_to_H * & - (CS%bathyT(i+1,j) * CS%bathyT(i,j)) / & - (CS%bathyT(i+1,j) + CS%bathyT(i,j)) + H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * GV%Z_to_H + Datu(I,j) = 0.0 + if ((H1 > 0.0) .and. (H2 > 0.0)) & + Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i, J) = 0.0 - !Would be "if (G%mask2dCv(i,J)>0.) &" is G was valid on BT domain - if (CS%bathyT(i,j+1)+CS%bathyT(i,j)>0.) & - Datv(i,J) = 2.0*CS%dx_Cv(i,J) * GV%Z_to_H * & - (CS%bathyT(i,j+1) * CS%bathyT(i,j)) / & - (CS%bathyT(i,j+1) + CS%bathyT(i,j)) + H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * GV%Z_to_H + Datv(i,J) = 0.0 + if ((H1 > 0.0) .and. (H2 > 0.0)) & + Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo endif !$OMP end parallel @@ -4660,7 +4678,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! IareaT, IdxCu, and IdyCv need to be allocated with wide halos. ALLOC_(CS%IareaT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IareaT(:,:) = 0.0 - ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = GV%Angstrom_m !### Change to 0.0? + ALLOC_(CS%bathyT(CS%isdw:CS%iedw,CS%jsdw:CS%jedw)) ; CS%bathyT(:,:) = 0.0 ALLOC_(CS%IdxCu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%IdxCu(:,:) = 0.0 ALLOC_(CS%IdyCv(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) ; CS%IdyCv(:,:) = 0.0 ALLOC_(CS%dy_Cu(CS%isdw-1:CS%iedw,CS%jsdw:CS%jedw)) ; CS%dy_Cu(:,:) = 0.0 @@ -4726,7 +4744,7 @@ 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)) ; lin_drag_h(:,:) = 0.0 + allocate(lin_drag_h(isd:ied,jsd:jed), source=0.0) call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=US%m_to_Z*US%T_to_s) call pass_var(lin_drag_h, G%Domain) diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 2e25af2460..dc89f3f92c 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -17,6 +17,7 @@ module MOM_boundary_update use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type +use DOME_initialization, only : register_DOME_OBC use tidal_bay_initialization, only : tidal_bay_set_OBC_data, register_tidal_bay_OBC use tidal_bay_initialization, only : tidal_bay_OBC_end, tidal_bay_OBC_CS use Kelvin_initialization, only : Kelvin_set_OBC_data, register_Kelvin_OBC @@ -58,13 +59,15 @@ module MOM_boundary_update !> The following subroutines and associated definitions provide the !! machinery to register and call the subroutines that initialize !! open boundary conditions. -subroutine call_OBC_register(param_file, CS, US, OBC) +subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(update_OBC_CS), pointer :: CS !< Control structure for OBCs type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. ! Local variables + character(len=200) :: config character(len=40) :: mdl = "MOM_boundary_update" ! This module's name. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -91,10 +94,29 @@ subroutine call_OBC_register(param_file, CS, US, OBC) call get_param(param_file, mdl, "USE_DYED_CHANNEL_OBC", CS%use_dyed_channel, & "If true, use the dyed channel open boundary.", & default=.false.) + call get_param(param_file, 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"//& + " dyed_channel - supercritical with dye on the inflow boundary\n"//& + " dyed_obcs - circle_obcs with dyes on the open boundaries\n"//& + " Kelvin - barotropic Kelvin wave forcing on the western boundary\n"//& + " shelfwave - Flather with shelf wave forcing on western boundary\n"//& + " supercritical - now only needed here for the allocations\n"//& + " tidal_bay - Flather with tidal forcing on eastern boundary\n"//& + " USER - user specified", default="none", do_not_log=.true.) if (CS%use_files) CS%use_files = & register_file_OBC(param_file, CS%file_OBC_CSp, US, & OBC%OBC_Reg) + + if (trim(config) == "DOME") then + call register_DOME_OBC(param_file, US, OBC, tr_Reg) +! elseif (trim(config) == "tidal_bay") then +! elseif (trim(config) == "Kelvin") then +! elseif (trim(config) == "shelfwave") then +! elseif (trim(config) == "dyed_channel") then + endif + if (CS%use_tidal_bay) CS%use_tidal_bay = & register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC_CSp, US, & OBC%OBC_Reg) @@ -150,7 +172,7 @@ end subroutine OBC_register_end !> \namespace mom_boundary_update !! This module updates the open boundary arrays when time-varying. -!! It caused a circular dependency with the tidal_bay setup when +!! It caused a circular dependency with the tidal_bay and other setups when in !! MOM_open_boundary. !! !! A small fragment of the grid is shown below: diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 302ba0a714..04e151d5a7 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -38,7 +38,7 @@ module MOM_density_integrals !! required for calculating the finite-volume form pressure accelerations in a !! Boussinesq model. subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, & - intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, Z_0p) type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structures for the arrays real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: T !< Potential temperature referenced to the surface [degC] @@ -78,13 +78,14 @@ subroutine int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, real, optional, intent(in) :: dz_neglect !< A minuscule thickness change [Z ~> m] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] if (EOS_quadrature(EOS)) then call int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, US, dpa, & - intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, Z_0p=Z_0p) else call analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, dpa, & - intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, Z_0p=Z_0p) endif end subroutine int_density_dz @@ -93,8 +94,8 @@ end subroutine int_density_dz !> Calculates (by numerical quadrature) integrals of pressure anomalies across layers, which !! are required for calculating the finite-volume form pressure accelerations in a Boussinesq model. subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & - EOS, US, dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp, use_inaccurate_form) + EOS, US, dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & + dz_neglect, useMassWghtInterp, use_inaccurate_form, Z_0p) type(hor_index_type), intent(in) :: HI !< Horizontal index type for input variables. real, dimension(SZI_(HI),SZJ_(HI)), & intent(in) :: T !< Potential temperature of the layer [degC] @@ -136,6 +137,8 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & !! interpolate T/S for top and bottom integrals. logical, optional, intent(in) :: use_inaccurate_form !< If true, uses an inaccurate form of !! density anomalies, as was used prior to March 2018. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] + ! Local variables real :: T5(5), S5(5) ! Temperatures and salinities at five quadrature points [degC] and [ppt] real :: p5(5) ! Pressures at five quadrature points, never rescaled from Pa [Pa] @@ -148,6 +151,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: rho_scale ! A scaling factor for densities from kg m-3 to R [R m3 kg-1 ~> 1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] real :: dz ! The layer thickness [Z ~> m] + real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: hWght ! A pressure-thickness below topography [Z ~> m] real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m] real :: iDenom ! The inverse of the denominator in the weights [Z-2 ~> m-2] @@ -173,6 +177,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & GxRho = US%RL2_T2_to_Pa * G_e * rho_0 rho_ref_mks = rho_ref * US%R_to_kg_m3 I_Rho = 1.0 / rho_0 + z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p use_rho_ref = .true. if (present(use_inaccurate_form)) then if (use_inaccurate_form) use_rho_ref = .not. use_inaccurate_form @@ -191,7 +196,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dz = z_t(i,j) - z_b(i,j) do n=1,5 T5(n) = T(i,j) ; S5(n) = S(i,j) - p5(n) = -GxRho*(z_t(i,j) - 0.25*real(n-1)*dz) + p5(n) = -GxRho*((z_t(i,j) - z0pres) - 0.25*real(n-1)*dz) enddo if (use_rho_ref) then if (rho_scale /= 1.0) then @@ -245,7 +250,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j)) T5(1) = wtT_L*T(i,j) + wtT_R*T(i+1,j) S5(1) = wtT_L*S(i,j) + wtT_R*S(i+1,j) - p5(1) = -GxRho*(wt_L*z_t(i,j) + wt_R*z_t(i+1,j)) + p5(1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i+1,j)) - z0pres) do n=2,5 T5(n) = T5(1) ; S5(n) = S5(1) ; p5(n) = p5(n-1) + GxRho*0.25*dz enddo @@ -300,7 +305,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1)) T5(1) = wtT_L*T(i,j) + wtT_R*T(i,j+1) S5(1) = wtT_L*S(i,j) + wtT_R*S(i,j+1) - p5(1) = -GxRho*(wt_L*z_t(i,j) + wt_R*z_t(i,j+1)) + p5(1) = -GxRho*((wt_L*z_t(i,j) + wt_R*z_t(i,j+1)) - z0pres) do n=2,5 T5(n) = T5(1) ; S5(n) = S5(1) p5(n) = p5(n-1) + GxRho*0.25*dz @@ -336,7 +341,7 @@ end subroutine int_density_dz_generic_pcm subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, dpa, & intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, & - use_inaccurate_form) + use_inaccurate_form, Z_0p) integer, intent(in) :: k !< Layer index to calculate integrals for type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structures for the input arrays type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -379,6 +384,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & !! interpolate T/S for top and bottom integrals. logical, optional, intent(in) :: use_inaccurate_form !< If true, uses an inaccurate form of !! density anomalies, as was used prior to March 2018. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -427,6 +433,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & real :: massWeightToggle ! A non-dimensional toggle factor (0 or 1) [nondim] real :: Ttl, Tbl, Ttr, Tbr ! Temperatures at the velocity cell corners [degC] real :: Stl, Sbl, Str, Sbr ! Salinities at the velocity cell corners [ppt] + real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: hWght ! A topographically limited thicknes weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] @@ -443,6 +450,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & GxRho = US%RL2_T2_to_Pa * G_e * rho_0 rho_ref_mks = rho_ref * US%R_to_kg_m3 I_Rho = 1.0 / rho_0 + z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p massWeightToggle = 0. if (present(useMassWghtInterp)) then if (useMassWghtInterp) massWeightToggle = 1. @@ -473,7 +481,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & do i = Isq,Ieq+1 dz(i) = e(i,j,K) - e(i,j,K+1) do n=1,5 - p5(i*5+n) = -GxRho*(e(i,j,K) - 0.25*real(n-1)*dz(i)) + p5(i*5+n) = -GxRho*((e(i,j,K) - z0pres) - 0.25*real(n-1)*dz(i)) ! Salinity and temperature points are linearly interpolated S5(i*5+n) = wt_t(n) * S_t(i,j,k) + wt_b(n) * S_b(i,j,k) T5(i*5+n) = wt_t(n) * T_t(i,j,k) + wt_b(n) * T_b(i,j,k) @@ -581,7 +589,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & S15(pos+1) = w_left*Stl + w_right*Str S15(pos+5) = w_left*Sbl + w_right*Sbr - p15(pos+1) = -GxRho*(w_left*e(i,j,K) + w_right*e(i+1,j,K)) + p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i+1,j,K)) - z0pres) ! Pressure do n=2,5 @@ -692,7 +700,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, & S15(pos+1) = w_left*Stl + w_right*Str S15(pos+5) = w_left*Sbl + w_right*Sbr - p15(pos+1) = -GxRho*(w_left*e(i,j,K) + w_right*e(i,j+1,K)) + p15(pos+1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i,j+1,K)) - z0pres) ! Pressure do n=2,5 @@ -775,7 +783,7 @@ end subroutine int_density_dz_generic_plm !! are parabolic profiles subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, & - dpa, intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp) + dpa, intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, Z_0p) integer, intent(in) :: k !< Layer index to calculate integrals for type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structures for the input arrays type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -816,6 +824,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & !! divided by the y grid spacing [R L2 T-2 ~> Pa] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! This subroutine calculates (by numerical quadrature) integrals of ! pressure anomalies across layers, which are required for calculating the @@ -854,6 +863,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: t6 ! PPM curvature coefficient for T [degC] real :: T_top, T_mn, T_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of T real :: S_top, S_mn, S_bot ! Left edge, cell mean and right edge values used in PPM reconstructions of S + real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: hWght ! A topographically limited thicknes weight [Z ~> m] real :: hL, hR ! Thicknesses to the left and right [Z ~> m] real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2] @@ -868,6 +878,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & GxRho = US%RL2_T2_to_Pa * G_e * rho_0 rho_ref_mks = rho_ref * US%R_to_kg_m3 I_Rho = 1.0 / rho_0 + z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p massWeightToggle = 0. if (present(useMassWghtInterp)) then if (useMassWghtInterp) massWeightToggle = 1. @@ -900,7 +911,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & endif dz = e(i,j,K) - e(i,j,K+1) do n=1,5 - p5(n) = -GxRho*(e(i,j,K) - 0.25*real(n-1)*dz) + p5(n) = -GxRho*((e(i,j,K) - z0pres) - 0.25*real(n-1)*dz) ! Salinity and temperature points are reconstructed with PPM S5(n) = wt_t(n) * S_t(i,j,k) + wt_b(n) * ( S_b(i,j,k) + s6 * wt_t(n) ) T5(n) = wt_t(n) * T_t(i,j,k) + wt_b(n) * ( T_b(i,j,k) + t6 * wt_t(n) ) @@ -978,7 +989,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & ! Pressure dz = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i+1,j,K) - e(i+1,j,K+1)) - p5(1) = -GxRho*(w_left*e(i,j,K) + w_right*e(i+1,j,K)) + p5(1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i+1,j,K)) - z0pres) do n=2,5 p5(n) = p5(n-1) + GxRho*0.25*dz enddo @@ -1066,7 +1077,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & ! Pressure dz = w_left*(e(i,j,K) - e(i,j,K+1)) + w_right*(e(i,j+1,K) - e(i,j+1,K+1)) - p5(1) = -GxRho*(w_left*e(i,j,K) + w_right*e(i,j+1,K)) + p5(1) = -GxRho*((w_left*e(i,j,K) + w_right*e(i,j+1,K)) - z0pres) do n=2,5 p5(n) = p5(n-1) + GxRho*0.25*dz enddo diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 291703a242..0532aeac53 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -169,10 +169,12 @@ module MOM_dynamics_split_RK2 integer :: id_h_PFu = -1, id_h_PFv = -1 integer :: id_hf_PFu_2d = -1, id_hf_PFv_2d = -1 integer :: id_intz_PFu_2d = -1, id_intz_PFv_2d = -1 + integer :: id_PFu_visc_rem = -1, id_PFv_visc_rem = -1 ! integer :: id_hf_CAu = -1, id_hf_CAv = -1 integer :: id_h_CAu = -1, id_h_CAv = -1 integer :: id_hf_CAu_2d = -1, id_hf_CAv_2d = -1 integer :: id_intz_CAu_2d = -1, id_intz_CAv_2d = -1 + integer :: id_CAu_visc_rem = -1, id_CAv_visc_rem = -1 ! Split scheme only. integer :: id_uav = -1, id_vav = -1 @@ -181,6 +183,7 @@ module MOM_dynamics_split_RK2 integer :: id_h_u_BT_accel = -1, id_h_v_BT_accel = -1 integer :: id_hf_u_BT_accel_2d = -1, id_hf_v_BT_accel_2d = -1 integer :: id_intz_u_BT_accel_2d = -1, id_intz_v_BT_accel_2d = -1 + integer :: id_u_BT_accel_visc_rem = -1, id_v_BT_accel_visc_rem = -1 !>@} type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the @@ -360,6 +363,12 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, dimension(SZI_(G),SZJB_(G)) :: & intz_PFv_2d, intz_CAv_2d, intz_v_BT_accel_2d ! [H L T-2 ~> m2 s-2]. + ! Diagnostics for momentum budget terms multiplied by visc_rem_[uv], + real, allocatable, dimension(:,:,:) :: & + PFu_visc_rem, PFv_visc_rem, & ! Pressure force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. + CAu_visc_rem, CAv_visc_rem, & ! Coriolis force accel. x visc_rem_[uv] [L T-2 ~> m s-2]. + u_BT_accel_visc_rem, v_BT_accel_visc_rem ! barotropic correction accel. x visc_rem_[uv] [L T-2 ~> m s-2]. + real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. logical :: dyn_p_surf @@ -937,8 +946,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_hf_PFu_2d > 0) then - allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_PFu_2d(:,:) = 0.0 + allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_PFu_2d(I,j) = hf_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -946,8 +954,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(hf_PFu_2d) endif if (CS%id_hf_PFv_2d > 0) then - allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_PFv_2d(:,:) = 0.0 + allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_PFv_2d(i,J) = hf_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -956,8 +963,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_h_PFu > 0) then - allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_PFu(:,:,:) = 0.0 + allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -965,8 +971,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_PFu) endif if (CS%id_h_PFv > 0) then - allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_PFv(:,:,:) = 0.0 + allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1004,8 +1009,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_hf_CAu_2d > 0) then - allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_CAu_2d(:,:) = 0.0 + allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_CAu_2d(I,j) = hf_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -1013,8 +1017,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(hf_CAu_2d) endif if (CS%id_hf_CAv_2d > 0) then - allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_CAv_2d(:,:) = 0.0 + allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_CAv_2d(i,J) = hf_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -1023,8 +1026,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_h_CAu > 0) then - allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_CAu(:,:,:) = 0.0 + allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -1032,8 +1034,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_CAu) endif if (CS%id_h_CAv > 0) then - allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_CAv(:,:,:) = 0.0 + allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1071,8 +1072,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_hf_u_BT_accel_2d > 0) then - allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_u_BT_accel_2d(:,:) = 0.0 + allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_u_BT_accel_2d(I,j) = hf_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -1080,8 +1080,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(hf_u_BT_accel_2d) endif if (CS%id_hf_v_BT_accel_2d > 0) then - allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_v_BT_accel_2d(:,:) = 0.0 + allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_v_BT_accel_2d(i,J) = hf_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -1090,8 +1089,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_h_u_BT_accel > 0) then - allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_u_BT_accel(:,:,:) = 0.0 + allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -1099,8 +1097,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_u_BT_accel) endif if (CS%id_h_v_BT_accel > 0) then - allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_v_BT_accel(:,:,:) = 0.0 + allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1108,6 +1105,55 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_v_BT_accel) endif + if (CS%id_PFu_visc_rem > 0) then + allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + PFu_visc_rem(I,j,k) = CS%PFu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_PFu_visc_rem, PFu_visc_rem, CS%diag) + deallocate(PFu_visc_rem) + endif + if (CS%id_PFv_visc_rem > 0) then + allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + PFv_visc_rem(i,J,k) = CS%PFv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_PFv_visc_rem, PFv_visc_rem, CS%diag) + deallocate(PFv_visc_rem) + endif + if (CS%id_CAu_visc_rem > 0) then + allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + CAu_visc_rem(I,j,k) = CS%CAu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_CAu_visc_rem, CAu_visc_rem, CS%diag) + deallocate(CAu_visc_rem) + endif + if (CS%id_CAv_visc_rem > 0) then + allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + CAv_visc_rem(i,J,k) = CS%CAv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_CAv_visc_rem, CAv_visc_rem, CS%diag) + deallocate(CAv_visc_rem) + endif + if (CS%id_u_BT_accel_visc_rem > 0) then + allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + u_BT_accel_visc_rem(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_u_BT_accel_visc_rem, u_BT_accel_visc_rem, CS%diag) + deallocate(u_BT_accel_visc_rem) + endif + if (CS%id_v_BT_accel_visc_rem > 0) then + allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + v_BT_accel_visc_rem(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_v_BT_accel_visc_rem, v_BT_accel_visc_rem, CS%diag) + deallocate(v_BT_accel_visc_rem) + endif + if (CS%debug) then call MOM_state_chksum("Corrector ", u, v, h, uh, vh, G, GV, US, symmetric=sym) call uvchksum("Corrector avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) @@ -1311,8 +1357,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & default=.false.) - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0) ALLOC_(CS%uhbt(IsdB:IedB,jsd:jed)) ; CS%uhbt(:,:) = 0.0 ALLOC_(CS%vhbt(isd:ied,JsdB:JedB)) ; CS%vhbt(:,:) = 0.0 @@ -1612,6 +1658,33 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) if (CS%id_intz_v_BT_accel_2d > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + CS%id_PFu_visc_rem = register_diag_field('ocean_model', 'PFu_visc_rem', diag%axesCuL, Time, & + 'Zonal Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_PFu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & + 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + + CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & + 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_CAu_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & + 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + + CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & + 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if (CS%id_u_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_u,IsdB,IedB,jsd,jed,nz) + CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & + 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + 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) id_clock_pres = cpu_clock_id('(Ocean pressure force)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 375f7e3ef1..6f33a00768 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -640,8 +640,8 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0) MIS%diffu => CS%diffu ; MIS%diffv => CS%diffv MIS%PFu => CS%PFu ; MIS%PFv => CS%PFv diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index fea7f0d873..18a192cb39 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -602,8 +602,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0) MIS%diffu => CS%diffu ; MIS%diffv => CS%diffv MIS%PFu => CS%PFu ; MIS%PFv => CS%PFv diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index 1ac5e39dd5..7592dc8477 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -283,10 +283,10 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v G%bathymetry_at_vel = .false. if (present(bathymetry_at_vel)) G%bathymetry_at_vel = bathymetry_at_vel if (G%bathymetry_at_vel) then - ALLOC_(G%Dblock_u(IsdB:IedB, jsd:jed)) ; G%Dblock_u(:,:) = 0.0 - ALLOC_(G%Dopen_u(IsdB:IedB, jsd:jed)) ; G%Dopen_u(:,:) = 0.0 - ALLOC_(G%Dblock_v(isd:ied, JsdB:JedB)) ; G%Dblock_v(:,:) = 0.0 - ALLOC_(G%Dopen_v(isd:ied, JsdB:JedB)) ; G%Dopen_v(:,:) = 0.0 + ALLOC_(G%Dblock_u(IsdB:IedB, jsd:jed)) ; G%Dblock_u(:,:) = -G%Z_ref + ALLOC_(G%Dopen_u(IsdB:IedB, jsd:jed)) ; G%Dopen_u(:,:) = -G%Z_ref + ALLOC_(G%Dblock_v(isd:ied, JsdB:JedB)) ; G%Dblock_v(:,:) = -G%Z_ref + ALLOC_(G%Dopen_v(isd:ied, JsdB:JedB)) ; G%Dopen_v(:,:) = -G%Z_ref endif ! setup block indices. @@ -387,6 +387,7 @@ end subroutine MOM_grid_init subroutine rescale_grid_bathymetry(G, m_in_new_units) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid structure real, intent(in) :: m_in_new_units !< The new internal representation of 1 m depth. + ! It appears that this routine is never called. ! Local variables real :: rescale @@ -578,7 +579,7 @@ subroutine allocate_metrics(G) ALLOC_(G%IareaCu(IsdB:IedB,jsd:jed)) ; G%IareaCu(:,:) = 0.0 ALLOC_(G%IareaCv(isd:ied,JsdB:JedB)) ; G%IareaCv(:,:) = 0.0 - ALLOC_(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = 0.0 + ALLOC_(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = -G%Z_ref ALLOC_(G%CoriolisBu(IsdB:IedB, JsdB:JedB)) ; G%CoriolisBu(:,:) = 0.0 ALLOC_(G%dF_dx(isd:ied, jsd:jed)) ; G%dF_dx(:,:) = 0.0 ALLOC_(G%dF_dy(isd:ied, jsd:jed)) ; G%dF_dy(:,:) = 0.0 @@ -586,10 +587,10 @@ subroutine allocate_metrics(G) ALLOC_(G%sin_rot(isd:ied,jsd:jed)) ; G%sin_rot(:,:) = 0.0 ALLOC_(G%cos_rot(isd:ied,jsd:jed)) ; G%cos_rot(:,:) = 1.0 - allocate(G%gridLonT(isg:ieg)) ; G%gridLonT(:) = 0.0 - allocate(G%gridLonB(G%IsgB:G%IegB)) ; G%gridLonB(:) = 0.0 - allocate(G%gridLatT(jsg:jeg)) ; G%gridLatT(:) = 0.0 - allocate(G%gridLatB(G%JsgB:G%JegB)) ; G%gridLatB(:) = 0.0 + allocate(G%gridLonT(isg:ieg), source=0.0) + allocate(G%gridLonB(G%IsgB:G%IegB), source=0.0) + allocate(G%gridLatT(jsg:jeg), source=0.0) + allocate(G%gridLatB(G%JsgB:G%JegB), source=0.0) end subroutine allocate_metrics diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index ec7501c5f0..17729e586c 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -28,7 +28,7 @@ module MOM_interface_heights !! form for consistency with the calculation of the pressure gradient forces. !! Additionally, these height may be dilated for consistency with the !! corresponding time-average quantity from the barotropic calculation. -subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) +subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref) 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 @@ -37,14 +37,17 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) !! thermodynamic variables. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: eta !< layer interface heights !! [Z ~> m] or [1/eta_to_m m]. - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic - !! variable that gives the "correct" free surface height (Boussinesq) or total water - !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. - !! thicknesses when calculating interfaceheights [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable + !! that gives the "correct" free surface height (Boussinesq) or total water + !! column mass per unit area (non-Boussinesq). This is used to dilate the layer + !! thicknesses when calculating interface heights [H ~> m or kg m-2]. + !! In Boussinesq mode, eta_bt and G%bathyT use the same reference height. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is US%Z_to_m. + !! the units of eta to m; by default this is US%Z_to_m. + real, optional, intent(in) :: dZref !< The difference in the + !! reference height between G%bathyT and eta [Z ~> m]. The default is 0. ! Local variables real :: p(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] @@ -55,6 +58,8 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real :: I_gEarth ! The inverse of the gravitational acceleration times the ! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1] real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. + real :: dZ_ref ! The difference in the reference height between G%bathyT and eta [Z ~> m]. + ! dZ_ref is 0 unless the optional argument dZref is present. integer i, j, k, isv, iev, jsv, jev, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) @@ -69,33 +74,35 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_RZ * Z_to_eta I_gEarth = Z_to_eta / GV%g_Earth + dZ_ref = 0.0 ; if (present(dZref)) dZ_ref = dZref -!$OMP parallel default(shared) private(dilate,htot) -!$OMP do - do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo + !$OMP parallel default(shared) private(dilate,htot) + !$OMP do + do j=jsv,jev ; do i=isv,iev ; eta(i,j,nz+1) = -Z_to_eta*(G%bathyT(i,j) + dZ_ref) ; enddo ; enddo if (GV%Boussinesq) then -!$OMP do + !$OMP do do j=jsv,jev ; do k=nz,1,-1 ; do i=isv,iev eta(i,j,K) = eta(i,j,K+1) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo if (present(eta_bt)) then ! Dilate the water column to agree with the free surface height ! that is used for the dynamics. -!$OMP do + !$OMP do do j=jsv,jev do i=isv,iev dilate(i) = (eta_bt(i,j)*H_to_eta + Z_to_eta*G%bathyT(i,j)) / & - (eta(i,j,1) + Z_to_eta*G%bathyT(i,j)) + (eta(i,j,1) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) - & + Z_to_eta*(G%bathyT(i,j) + dZ_ref) enddo ; enddo enddo endif else if (associated(tv%eqn_of_state)) then -!$OMP do + !$OMP do do j=jsv,jev if (associated(tv%p_surf)) then do i=isv,iev ; p(i,j,1) = tv%p_surf(i,j) ; enddo @@ -106,19 +113,19 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) p(i,j,K+1) = p(i,j,K) + GV%g_Earth*GV%H_to_RZ*h(i,j,k) enddo ; enddo enddo -!$OMP do + !$OMP do do k=1,nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,K), p(:,:,K+1), & 0.0, G%HI, tv%eqn_of_state, US, dz_geo(:,:,k), halo_size=halo) enddo -!$OMP do + !$OMP do do j=jsv,jev do k=nz,1,-1 ; do i=isv,iev eta(i,j,K) = eta(i,j,K+1) + I_gEarth * dz_geo(i,j,k) enddo ; enddo enddo else -!$OMP do + !$OMP do do j=jsv,jev ; do k=nz,1,-1 ; do i=isv,iev eta(i,j,K) = eta(i,j,K+1) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo @@ -126,18 +133,19 @@ subroutine find_eta_3d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) if (present(eta_bt)) then ! Dilate the water column to agree with the free surface height ! from the time-averaged barotropic solution. -!$OMP do + !$OMP do do j=jsv,jev do i=isv,iev ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=isv,iev ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=isv,iev ; dilate(i) = eta_bt(i,j) / htot(i) ; enddo do k=1,nz ; do i=isv,iev - eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*G%bathyT(i,j)) - Z_to_eta*G%bathyT(i,j) + eta(i,j,K) = dilate(i) * (eta(i,j,K) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) - & + Z_to_eta*(G%bathyT(i,j) + dZ_ref) enddo ; enddo enddo endif endif -!$OMP end parallel + !$OMP end parallel end subroutine find_eta_3d @@ -145,7 +153,7 @@ end subroutine find_eta_3d !! with the calculation of the pressure gradient forces. Additionally, the sea !! surface height may be adjusted for consistency with the corresponding !! time-average quantity from the barotropic calculation. -subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) +subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m, dZref) 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 @@ -155,12 +163,16 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height relative to !! mean sea level (z=0) often [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic - !! variable that gives the "correct" free surface height (Boussinesq) or total - !! water column mass per unit area (non-Boussinesq) [H ~> m or kg m-2]. + !! variable that gives the "correct" free surface height (Boussinesq) or total + !! water column mass per unit area (non-Boussinesq) [H ~> m or kg m-2]. + !! In Boussinesq mode, eta_bt and G%bathyT use the same reference height. integer, optional, intent(in) :: halo_size !< width of halo points on !! which to calculate eta. real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is US%Z_to_m. + !! the units of eta to m; by default this is US%Z_to_m. + real, optional, intent(in) :: dZref !< The difference in the + !! reference height between G%bathyT and eta [Z ~> m]. The default is 0. + ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & p ! Hydrostatic pressure at each interface [R L2 T-2 ~> Pa] @@ -170,6 +182,8 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) real :: I_gEarth ! The inverse of the gravitational acceleration times the ! rescaling factor derived from eta_to_m [T2 Z L-2 ~> s2 m-1] real :: Z_to_eta, H_to_eta, H_to_rho_eta ! Unit conversion factors with obvious names. + real :: dZ_ref ! The difference in the reference height between G%bathyT and eta [Z ~> m]. + ! dZ_ref is 0 unless the optional argument dZref is present. integer i, j, k, is, ie, js, je, nz, halo halo = 0 ; if (present(halo_size)) halo = max(0,halo_size) @@ -180,26 +194,27 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) H_to_eta = GV%H_to_Z * Z_to_eta H_to_rho_eta = GV%H_to_RZ * Z_to_eta I_gEarth = Z_to_eta / GV%g_Earth + dZ_ref = 0.0 ; if (present(dZref)) dZ_ref = dZref -!$OMP parallel default(shared) private(htot) -!$OMP do - do j=js,je ; do i=is,ie ; eta(i,j) = -Z_to_eta*G%bathyT(i,j) ; enddo ; enddo + !$OMP parallel default(shared) private(htot) + !$OMP do + do j=js,je ; do i=is,ie ; eta(i,j) = -Z_to_eta*(G%bathyT(i,j) + dZ_ref) ; enddo ; enddo if (GV%Boussinesq) then if (present(eta_bt)) then -!$OMP do + !$OMP do do j=js,je ; do i=is,ie - eta(i,j) = H_to_eta*eta_bt(i,j) + eta(i,j) = H_to_eta*eta_bt(i,j) - Z_to_eta*dZ_ref enddo ; enddo else -!$OMP do + !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie eta(i,j) = eta(i,j) + h(i,j,k)*H_to_eta enddo ; enddo ; enddo endif else if (associated(tv%eqn_of_state)) then -!$OMP do + !$OMP do do j=js,je if (associated(tv%p_surf)) then do i=is,ie ; p(i,j,1) = tv%p_surf(i,j) ; enddo @@ -211,17 +226,17 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) p(i,j,k+1) = p(i,j,k) + GV%g_Earth*GV%H_to_RZ*h(i,j,k) enddo ; enddo enddo -!$OMP do + !$OMP do do k = 1, nz call int_specific_vol_dp(tv%T(:,:,k), tv%S(:,:,k), p(:,:,k), p(:,:,k+1), 0.0, & G%HI, tv%eqn_of_state, US, dz_geo(:,:,k), halo_size=halo) enddo -!$OMP do + !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie eta(i,j) = eta(i,j) + I_gEarth * dz_geo(i,j,k) enddo ; enddo ; enddo else -!$OMP do + !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie eta(i,j) = eta(i,j) + H_to_rho_eta*h(i,j,k) / GV%Rlay(k) enddo ; enddo ; enddo @@ -229,18 +244,18 @@ subroutine find_eta_2d(h, tv, G, GV, US, eta, eta_bt, halo_size, eta_to_m) if (present(eta_bt)) then ! Dilate the water column to agree with the time-averaged column ! mass from the barotropic solution. -!$OMP do + !$OMP do do j=js,je do i=is,ie ; htot(i) = GV%H_subroundoff ; enddo do k=1,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + Z_to_eta*G%bathyT(i,j)) - & - Z_to_eta*G%bathyT(i,j) + eta(i,j) = (eta_bt(i,j) / htot(i)) * (eta(i,j) + Z_to_eta*(G%bathyT(i,j) + dZ_ref)) - & + Z_to_eta*(G%bathyT(i,j) + dZ_ref) enddo enddo endif endif -!$OMP end parallel + !$OMP end parallel end subroutine find_eta_2d diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index bd76f5a9aa..f0b1158b22 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -342,8 +342,6 @@ module MOM_open_boundary integer :: id_clock_pass !< A CPU time clock character(len=40) :: mdl = "MOM_open_boundary" !< This module's name. -! This include declares and sets the variable "version". -#include "version_variable.h" contains @@ -359,6 +357,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + ! Local variables integer :: l ! For looping over segments logical :: debug_OBC, debug, mask_outside, reentrant_x, reentrant_y @@ -370,6 +369,9 @@ subroutine open_boundary_config(G, US, param_file, OBC) logical :: answers_2018, default_2018_answers logical :: check_reconstruction, check_remapping, force_bounds_in_subcell character(len=32) :: remappingScheme +! This include declares and sets the variable "version". +# include "version_variable.h" + allocate(OBC) call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & @@ -521,8 +523,8 @@ subroutine open_boundary_config(G, US, param_file, OBC) OBC%segment(l)%Velocity_nudging_timescale_out = 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 + allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed), source=OBC_NONE) + allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB), source=OBC_NONE) do l = 1, OBC%number_of_segments write(segment_param_str(1:15),"('OBC_SEGMENT_',i3.3)") l @@ -3520,88 +3522,72 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%is_E_or_W) then ! If these are just Flather, change update_OBC_segment_data accordingly - allocate(segment%Cg(IsdB:IedB,jsd:jed)); segment%Cg(:,:)=0. - allocate(segment%Htot(IsdB:IedB,jsd:jed)); segment%Htot(:,:)=0.0 - allocate(segment%h(IsdB:IedB,jsd:jed,OBC%ke)); segment%h(:,:,:)=0.0 - allocate(segment%eta(IsdB:IedB,jsd:jed)); segment%eta(:,:)=0.0 - if (segment%radiation) then - allocate(segment%rx_norm_rad(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_norm_rad(:,:,:)=0.0 - endif - allocate(segment%normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_vel(:,:,:)=0.0 - allocate(segment%normal_vel_bt(IsdB:IedB,jsd:jed)); segment%normal_vel_bt(:,:)=0.0 - allocate(segment%normal_trans(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_trans(:,:,:)=0.0 - if (segment%nudged) then - allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 - endif + allocate(segment%Cg(IsdB:IedB,jsd:jed), source=0.0) + allocate(segment%Htot(IsdB:IedB,jsd:jed), source=0.0) + allocate(segment%h(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%eta(IsdB:IedB,jsd:jed), source=0.0) + if (segment%radiation) & + allocate(segment%rx_norm_rad(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%normal_vel(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%normal_vel_bt(IsdB:IedB,jsd:jed), source=0.0) + allocate(segment%normal_trans(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + if (segment%nudged) & + allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) if (segment%radiation_tan .or. segment%nudged_tan .or. segment%specified_tan .or. & - segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) then - allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_tan) then - allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_grad) then - allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 - endif + segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) & + allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_tan) & + allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_grad) & + allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & - segment%oblique_grad .or. segment%specified_grad) then - allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 - endif + segment%oblique_grad .or. segment%specified_grad) & + allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (segment%oblique) then - allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 - allocate(segment%rx_norm_obl(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_norm_obl(:,:,:)=0.0 - allocate(segment%ry_norm_obl(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_norm_obl(:,:,:)=0.0 - allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 - endif - if (segment%oblique_tan) then - allocate(segment%grad_tan(jsd-1:jed+1,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 - endif - if (segment%oblique_grad) then - allocate(segment%grad_gradient(jsd:jed,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke), source=0.0) + allocate(segment%rx_norm_obl(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%ry_norm_obl(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) endif + if (segment%oblique_tan) & + allocate(segment%grad_tan(jsd-1:jed+1,2,OBC%ke), source=0.0) + if (segment%oblique_grad) & + allocate(segment%grad_gradient(jsd:jed,2,OBC%ke), source=0.0) endif if (segment%is_N_or_S) then ! If these are just Flather, change update_OBC_segment_data accordingly - allocate(segment%Cg(isd:ied,JsdB:JedB)); segment%Cg(:,:)=0. - allocate(segment%Htot(isd:ied,JsdB:JedB)); segment%Htot(:,:)=0.0 - allocate(segment%h(isd:ied,JsdB:JedB,OBC%ke)); segment%h(:,:,:)=0.0 - allocate(segment%eta(isd:ied,JsdB:JedB)); segment%eta(:,:)=0.0 - if (segment%radiation) then - allocate(segment%ry_norm_rad(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_norm_rad(:,:,:)=0.0 - endif - allocate(segment%normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_vel(:,:,:)=0.0 - allocate(segment%normal_vel_bt(isd:ied,JsdB:JedB)); segment%normal_vel_bt(:,:)=0.0 - allocate(segment%normal_trans(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_trans(:,:,:)=0.0 - if (segment%nudged) then - allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 - endif + allocate(segment%Cg(isd:ied,JsdB:JedB), source=0.0) + allocate(segment%Htot(isd:ied,JsdB:JedB), source=0.0) + allocate(segment%h(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%eta(isd:ied,JsdB:JedB), source=0.0) + if (segment%radiation) & + allocate(segment%ry_norm_rad(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%normal_vel(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%normal_vel_bt(isd:ied,JsdB:JedB), source=0.0) + allocate(segment%normal_trans(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged) & + allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke), source=0.0) if (segment%radiation_tan .or. segment%nudged_tan .or. segment%specified_tan .or. & - segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) then - allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_tan) then - allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_grad) then - allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 - endif + segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) & + allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_tan) & + allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_grad) & + allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & - segment%oblique_grad .or. segment%specified_grad) then - allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 - endif + segment%oblique_grad .or. segment%specified_grad) & + allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (segment%oblique) then - allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 - allocate(segment%rx_norm_obl(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_norm_obl(:,:,:)=0.0 - allocate(segment%ry_norm_obl(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_norm_obl(:,:,:)=0.0 - allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 - endif - if (segment%oblique_tan) then - allocate(segment%grad_tan(isd-1:ied+1,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 - endif - if (segment%oblique_grad) then - allocate(segment%grad_gradient(isd:ied,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke), source=0.0) + allocate(segment%rx_norm_obl(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%ry_norm_obl(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke), source=0.0) endif + if (segment%oblique_tan) & + allocate(segment%grad_tan(isd-1:ied+1,2,OBC%ke), source=0.0) + if (segment%oblique_grad) & + allocate(segment%grad_gradient(isd:ied,2,OBC%ke), source=0.0) endif end subroutine allocate_OBC_segment_data @@ -3799,35 +3785,32 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! calculate auxiliary fields at staggered locations ishift=0;jshift=0 if (segment%is_E_or_W) then - allocate(normal_trans_bt(segment%HI%IsdB:segment%HI%IedB,segment%HI%jsd:segment%HI%jed)) - normal_trans_bt(:,:)=0.0 + allocate(normal_trans_bt(segment%HI%IsdB:segment%HI%IedB,segment%HI%jsd:segment%HI%jed), source=0.0) 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%Htot(I,j)=0.0 + segment%Htot(I,j) = 0.0 do k=1,GV%ke segment%h(I,j,k) = h(i+ishift,j,k) - segment%Htot(I,j)=segment%Htot(I,j)+segment%h(I,j,k) + segment%Htot(I,j) = segment%Htot(I,j) + segment%h(I,j,k) enddo + segment%Cg(I,j) = sqrt(GV%g_prime(1)*segment%Htot(I,j)*GV%H_to_Z) enddo else! (segment%direction == OBC_DIRECTION_N .or. segment%direction == OBC_DIRECTION_S) - allocate(normal_trans_bt(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB)) - normal_trans_bt(:,:)=0.0 + allocate(normal_trans_bt(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB), source=0.0) 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%Htot(i,J)=0.0 + segment%Htot(i,J) = 0.0 do k=1,GV%ke segment%h(i,J,k) = h(i,j+jshift,k) - segment%Htot(i,J)=segment%Htot(i,J)+segment%h(i,J,k) + segment%Htot(i,J) = segment%Htot(i,J) + segment%h(i,J,k) enddo + segment%Cg(i,J) = sqrt(GV%g_prime(1)*segment%Htot(i,J)*GV%H_to_Z) enddo endif - allocate(h_stack(GV%ke)) - h_stack(:) = 0.0 + allocate(h_stack(GV%ke), source=0.0) do m = 1,segment%num_fields if (segment%field(m)%fid > 0) then siz(1)=size(segment%field(m)%buffer_src,1) @@ -4433,8 +4416,8 @@ subroutine register_OBC(name, param_file, Reg) Reg%OB(nobc)%name = name if (Reg%locked) call MOM_error(FATAL, & - "MOM register_tracer was called for variable "//trim(Reg%OB(nobc)%name)//& - " with a locked tracer registry.") + "MOM register_OBC was called for OBC "//trim(Reg%OB(nobc)%name)//& + " with a locked OBC registry.") end subroutine register_OBC @@ -4445,7 +4428,7 @@ subroutine OBC_registry_init(param_file, Reg) integer, save :: init_calls = 0 -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "MOM_open_boundary" ! This module's name. character(len=256) :: mesg ! Message for error messages. @@ -4453,7 +4436,7 @@ subroutine OBC_registry_init(param_file, Reg) else ; return ; endif ! Read all relevant parameters and write them to the model log. -! call log_version(param_file, mdl,s version, "") +! call log_version(param_file, mdl, version, "") init_calls = init_calls + 1 if (init_calls > 1) then @@ -4503,7 +4486,7 @@ subroutine segment_tracer_registry_init(param_file, segment) integer, save :: init_calls = 0 ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "segment_tracer_registry_init" ! This routine's name. character(len=256) :: mesg ! Message for error messages. @@ -4527,6 +4510,8 @@ subroutine segment_tracer_registry_init(param_file, segment) end subroutine segment_tracer_registry_init +!> Register a tracer array that is active on an OBC segment, potentially also specifing how the +!! tracer inflow values are specified. subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_scalar, OBC_array) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -4537,7 +4522,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & !! but it also means that any updates to this !! structure in the calling module will be !! available subsequently to the tracer registry. - type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values + type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values type(OBC_segment_type), intent(inout) :: segment !< current segment data structure real, optional, intent(in) :: OBC_scalar !< If present, use scalar value for segment tracer !! inflow concentration. @@ -4555,8 +4540,8 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & if (segment%tr_Reg%ntseg>=MAX_FIELDS_) then write(mesg,'("Increase MAX_FIELDS_ in MOM_memory.h to at least ",I3," to allow for & - &all the tracers being registered via register_tracer.")') segment%tr_Reg%ntseg+1 - call MOM_error(FATAL,"MOM register_tracer: "//mesg) + &all the tracers being registered via register_segment_tracer.")') segment%tr_Reg%ntseg+1 + call MOM_error(FATAL,"MOM register_segment_tracer: "//mesg) endif segment%tr_Reg%ntseg = segment%tr_Reg%ntseg + 1 ntseg = segment%tr_Reg%ntseg @@ -4570,18 +4555,18 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name if (segment%tr_Reg%locked) call MOM_error(FATAL, & - "MOM register_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//& + "MOM register_segment_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//& " with a locked tracer registry.") if (present(OBC_scalar)) segment%tr_Reg%Tr(ntseg)%OBC_inflow_conc = OBC_scalar ! initialize tracer value later if (present(OBC_array)) then if (segment%is_E_or_W) then - allocate(segment%tr_Reg%Tr(ntseg)%t(IsdB:IedB,jsd:jed,1:GV%ke));segment%tr_Reg%Tr(ntseg)%t(:,:,:)=0.0 - allocate(segment%tr_Reg%Tr(ntseg)%tres(IsdB:IedB,jsd:jed,1:GV%ke));segment%tr_Reg%Tr(ntseg)%tres(:,:,:)=0.0 + allocate(segment%tr_Reg%Tr(ntseg)%t(IsdB:IedB,jsd:jed,1:GV%ke), source=0.0) + allocate(segment%tr_Reg%Tr(ntseg)%tres(IsdB:IedB,jsd:jed,1:GV%ke), source=0.0) segment%tr_Reg%Tr(ntseg)%is_initialized=.false. elseif (segment%is_N_or_S) then - allocate(segment%tr_Reg%Tr(ntseg)%t(isd:ied,JsdB:JedB,1:GV%ke));segment%tr_Reg%Tr(ntseg)%t(:,:,:)=0.0 - allocate(segment%tr_Reg%Tr(ntseg)%tres(isd:ied,JsdB:JedB,1:GV%ke));segment%tr_Reg%Tr(ntseg)%tres(:,:,:)=0.0 + allocate(segment%tr_Reg%Tr(ntseg)%t(isd:ied,JsdB:JedB,1:GV%ke), source=0.0) + allocate(segment%tr_Reg%Tr(ntseg)%tres(isd:ied,JsdB:JedB,1:GV%ke), source=0.0) segment%tr_Reg%Tr(ntseg)%is_initialized=.false. endif endif @@ -4711,7 +4696,7 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) integer :: i, j integer :: l_seg logical :: fatal_error = .False. - real :: min_depth + real :: min_depth ! The minimum depth for ocean points [Z ~> m] integer, parameter :: cin = 3, cout = 4, cland = -1, cedge = -2 character(len=256) :: mesg ! Message for error messages. type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list @@ -4722,10 +4707,10 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & units="m", default=0.0, scale=US%m_to_Z, do_not_log=.true.) + ! The reference depth on a dyn_horgrid is 0, otherwise would need: min_depth = min_depth - G%Z_ref - allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 - allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 - + allocate(color(G%isd:G%ied, G%jsd:G%jed), source=0.0) + allocate(color2(G%isd:G%ied, G%jsd:G%jed), source=0.0) ! Paint a frame around the outside. do j=G%jsd,G%jed @@ -4975,10 +4960,8 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using ! so much memory and disk space. *** if (OBC%radiation_BCs_exist_globally) then - allocate(OBC%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) - allocate(OBC%ry_normal(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke)) - OBC%rx_normal(:,:,:) = 0.0 - OBC%ry_normal(:,:,:) = 0.0 + allocate(OBC%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%ry_normal(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("rx_normal", "m s-1", "Normal Phase Speed for EW radiation OBCs", 'u', 'L') vd(2) = var_desc("ry_normal", "m s-1", "Normal Phase Speed for NS radiation OBCs", 'v', 'L') @@ -4987,18 +4970,15 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart endif if (OBC%oblique_BCs_exist_globally) then - allocate(OBC%rx_oblique(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) - allocate(OBC%ry_oblique(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke)) - OBC%rx_oblique(:,:,:) = 0.0 - OBC%ry_oblique(:,:,:) = 0.0 + allocate(OBC%rx_oblique(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%ry_oblique(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("rx_oblique", "m2 s-2", "Radiation Speed Squared for EW oblique OBCs", 'u', 'L') vd(2) = var_desc("ry_oblique", "m2 s-2", "Radiation Speed Squared for NS oblique OBCs", 'v', 'L') call register_restart_pair(OBC%rx_oblique, OBC%ry_oblique, vd(1), vd(2), & .false., restart_CSp) - allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) - OBC%cff_normal(:,:,:) = 0.0 + allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("cff_normal", "m2 s-2", "denominator for oblique OBCs", 'q', 'L') call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CSp) endif @@ -5006,10 +4986,8 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (Reg%ntr == 0) return if (.not. associated(OBC%tracer_x_reservoirs_used)) then OBC%ntr = Reg%ntr - allocate(OBC%tracer_x_reservoirs_used(Reg%ntr)) - allocate(OBC%tracer_y_reservoirs_used(Reg%ntr)) - OBC%tracer_x_reservoirs_used(:) = .false. - OBC%tracer_y_reservoirs_used(:) = .false. + allocate(OBC%tracer_x_reservoirs_used(Reg%ntr), source=.false.) + allocate(OBC%tracer_y_reservoirs_used(Reg%ntr), source=.false.) call parse_for_tracer_reservoirs(OBC, param_file, use_temperature) else ! This would be coming from user code such as DOME. @@ -5022,8 +5000,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart ! Still painfully inefficient, now in four dimensions. if (any(OBC%tracer_x_reservoirs_used)) then - allocate(OBC%tres_x(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke,OBC%ntr)) - OBC%tres_x(:,:,:,:) = 0.0 + allocate(OBC%tres_x(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke,OBC%ntr), source=0.0) do m=1,OBC%ntr if (OBC%tracer_x_reservoirs_used(m)) then if (modulo(HI%turns, 2) /= 0) then @@ -5039,8 +5016,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart enddo endif if (any(OBC%tracer_y_reservoirs_used)) then - allocate(OBC%tres_y(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke,OBC%ntr)) - OBC%tres_y(:,:,:,:) = 0.0 + allocate(OBC%tres_y(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke,OBC%ntr), source=0.0) do m=1,OBC%ntr if (OBC%tracer_y_reservoirs_used(m)) then if (modulo(HI%turns, 2) /= 0) then diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 51d44c1041..a9626a805c 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -20,7 +20,8 @@ module MOM_transcribe_grid contains !> Copies information from a dynamic (shared) horizontal grid type into an -!! ocean_grid_type. +!! ocean_grid_type. There may also be a change in the reference +!! height for topography between the two grids. 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 @@ -54,7 +55,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%dxT(i,j) = dG%dxT(i+ido,j+jdo) oG%dyT(i,j) = dG%dyT(i+ido,j+jdo) oG%areaT(i,j) = dG%areaT(i+ido,j+jdo) - oG%bathyT(i,j) = dG%bathyT(i+ido,j+jdo) + oG%bathyT(i,j) = dG%bathyT(i+ido,j+jdo) - oG%Z_ref oG%dF_dx(i,j) = dG%dF_dx(i+ido,j+jdo) oG%dF_dy(i,j) = dG%dF_dy(i+ido,j+jdo) @@ -100,12 +101,12 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%bathymetry_at_vel = dG%bathymetry_at_vel if (oG%bathymetry_at_vel) then do I=IsdB,IedB ; do j=jsd,jed - oG%Dblock_u(I,j) = dG%Dblock_u(I+ido,j+jdo) - oG%Dopen_u(I,j) = dG%Dopen_u(I+ido,j+jdo) + oG%Dblock_u(I,j) = dG%Dblock_u(I+ido,j+jdo) - oG%Z_ref + oG%Dopen_u(I,j) = dG%Dopen_u(I+ido,j+jdo) - oG%Z_ref enddo ; enddo do i=isd,ied ; do J=JsdB,JedB - oG%Dblock_v(i,J) = dG%Dblock_v(i+ido,J+jdo) - oG%Dopen_v(i,J) = dG%Dopen_v(i+ido,J+jdo) + oG%Dblock_v(i,J) = dG%Dblock_v(i+ido,J+jdo) - oG%Z_ref + oG%Dopen_v(i,J) = dG%Dopen_v(i+ido,J+jdo) - oG%Z_ref enddo ; enddo endif @@ -164,7 +165,8 @@ end subroutine copy_dyngrid_to_MOM_grid !> Copies information from an ocean_grid_type into a dynamic (shared) -!! horizontal grid type. +!! horizontal grid type. There may also be a change in the reference +!! height for topography between the two grids. 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 @@ -198,7 +200,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%dxT(i,j) = oG%dxT(i+ido,j+jdo) dG%dyT(i,j) = oG%dyT(i+ido,j+jdo) dG%areaT(i,j) = oG%areaT(i+ido,j+jdo) - dG%bathyT(i,j) = oG%bathyT(i+ido,j+jdo) + dG%bathyT(i,j) = oG%bathyT(i+ido,j+jdo) + oG%Z_ref dG%dF_dx(i,j) = oG%dF_dx(i+ido,j+jdo) dG%dF_dy(i,j) = oG%dF_dy(i+ido,j+jdo) @@ -244,12 +246,12 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%bathymetry_at_vel = oG%bathymetry_at_vel if (dG%bathymetry_at_vel) then do I=IsdB,IedB ; do j=jsd,jed - dG%Dblock_u(I,j) = oG%Dblock_u(I+ido,j+jdo) - dG%Dopen_u(I,j) = oG%Dopen_u(I+ido,j+jdo) + dG%Dblock_u(I,j) = oG%Dblock_u(I+ido,j+jdo) + oG%Z_ref + dG%Dopen_u(I,j) = oG%Dopen_u(I+ido,j+jdo) + oG%Z_ref enddo ; enddo do i=isd,ied ; do J=JsdB,JedB - dG%Dblock_v(i,J) = oG%Dblock_v(i+ido,J+jdo) - dG%Dopen_v(i,J) = oG%Dopen_v(i+ido,J+jdo) + dG%Dblock_v(i,J) = oG%Dblock_v(i+ido,J+jdo) + oG%Z_ref + dG%Dopen_v(i,J) = oG%Dopen_v(i+ido,J+jdo) + oG%Z_ref enddo ; enddo endif diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 86b373b8dd..363f3eebfb 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -171,6 +171,10 @@ module MOM_variables 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_str => NULL(), & !< Zonal acceleration due to the surface stress (included + !! in du_dt_visc) [L T-2 ~> m s-2] + dv_dt_str => NULL(), & !< Meridional acceleration due to the surface stress (included + !! in dv_dt_visc) [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] u_accel_bt => NULL(), &!< Pointer to the zonal barotropic-solver acceleration [L T-2 ~> m s-2] @@ -193,6 +197,9 @@ module MOM_variables real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points + real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points + real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points + end type accel_diag_ptrs !> Pointers to arrays with transports, which can later be used for derived diagnostics, like energy balances. @@ -341,43 +348,43 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (sfc_state%arrays_allocated) return if (use_temp) then - allocate(sfc_state%SST(isd:ied,jsd:jed)) ; sfc_state%SST(:,:) = 0.0 - allocate(sfc_state%SSS(isd:ied,jsd:jed)) ; sfc_state%SSS(:,:) = 0.0 + allocate(sfc_state%SST(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%SSS(isd:ied,jsd:jed), source=0.0) else - allocate(sfc_state%sfc_density(isd:ied,jsd:jed)) ; sfc_state%sfc_density(:,:) = 0.0 + allocate(sfc_state%sfc_density(isd:ied,jsd:jed), source=0.0) endif if (use_temp .and. alloc_frazil) then - allocate(sfc_state%frazil(isd:ied,jsd:jed)) ; sfc_state%frazil(:,:) = 0.0 + allocate(sfc_state%frazil(isd:ied,jsd:jed), source=0.0) endif - allocate(sfc_state%sea_lev(isd:ied,jsd:jed)) ; sfc_state%sea_lev(:,:) = 0.0 - allocate(sfc_state%Hml(isd:ied,jsd:jed)) ; sfc_state%Hml(:,:) = 0.0 - allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0 - allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0 + allocate(sfc_state%sea_lev(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%Hml(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%u(IsdB:IedB,jsd:jed), source=0.0) + allocate(sfc_state%v(isd:ied,JsdB:JedB), source=0.0) if (use_melt_potential) then - allocate(sfc_state%melt_potential(isd:ied,jsd:jed)) ; sfc_state%melt_potential(:,:) = 0.0 + allocate(sfc_state%melt_potential(isd:ied,jsd:jed), source=0.0) endif if (alloc_cfcs) then - allocate(sfc_state%sfc_cfc11(isd:ied,jsd:jed)) ; sfc_state%sfc_cfc11(:,:) = 0.0 - allocate(sfc_state%sfc_cfc12(isd:ied,jsd:jed)) ; sfc_state%sfc_cfc12(:,:) = 0.0 + allocate(sfc_state%sfc_cfc11(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%sfc_cfc12(isd:ied,jsd:jed), source=0.0) endif if (alloc_integ) then ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, and ocean_salt. - allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0 + allocate(sfc_state%ocean_mass(isd:ied,jsd:jed), source=0.0) if (use_temp) then - allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 - allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0 - allocate(sfc_state%TempxPmE(isd:ied,jsd:jed)) ; sfc_state%TempxPmE(:,:) = 0.0 - allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 - allocate(sfc_state%internal_heat(isd:ied,jsd:jed)) ; sfc_state%internal_heat(:,:) = 0.0 + allocate(sfc_state%ocean_heat(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%ocean_salt(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%TempxPmE(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%salt_deficit(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%internal_heat(isd:ied,jsd:jed), source=0.0) endif endif if (alloc_iceshelves) then - allocate(sfc_state%taux_shelf(IsdB:IedB,jsd:jed)) ; sfc_state%taux_shelf(:,:) = 0.0 - allocate(sfc_state%tauy_shelf(isd:ied,JsdB:JedB)) ; sfc_state%tauy_shelf(:,:) = 0.0 + allocate(sfc_state%taux_shelf(IsdB:IedB,jsd:jed), source=0.0) + allocate(sfc_state%tauy_shelf(isd:ied,JsdB:JedB), source=0.0) endif if (present(gas_fields_ocn)) & @@ -502,23 +509,23 @@ subroutine alloc_BT_cont_type(BT_cont, G, GV, alloc_faces) "alloc_BT_cont_type called with an associated BT_cont_type pointer.") allocate(BT_cont) - allocate(BT_cont%FA_u_WW(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_WW(:,:) = 0.0 - allocate(BT_cont%FA_u_W0(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_W0(:,:) = 0.0 - allocate(BT_cont%FA_u_E0(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_E0(:,:) = 0.0 - allocate(BT_cont%FA_u_EE(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_EE(:,:) = 0.0 - allocate(BT_cont%uBT_WW(IsdB:IedB,jsd:jed)) ; BT_cont%uBT_WW(:,:) = 0.0 - allocate(BT_cont%uBT_EE(IsdB:IedB,jsd:jed)) ; BT_cont%uBT_EE(:,:) = 0.0 - - allocate(BT_cont%FA_v_SS(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_SS(:,:) = 0.0 - allocate(BT_cont%FA_v_S0(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_S0(:,:) = 0.0 - allocate(BT_cont%FA_v_N0(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_N0(:,:) = 0.0 - allocate(BT_cont%FA_v_NN(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_NN(:,:) = 0.0 - allocate(BT_cont%vBT_SS(isd:ied,JsdB:JedB)) ; BT_cont%vBT_SS(:,:) = 0.0 - allocate(BT_cont%vBT_NN(isd:ied,JsdB:JedB)) ; BT_cont%vBT_NN(:,:) = 0.0 + allocate(BT_cont%FA_u_WW(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%FA_u_W0(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%FA_u_E0(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%FA_u_EE(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%uBT_WW(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%uBT_EE(IsdB:IedB,jsd:jed), source=0.0) + + allocate(BT_cont%FA_v_SS(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%FA_v_S0(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%FA_v_N0(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%FA_v_NN(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%vBT_SS(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%vBT_NN(isd:ied,JsdB:JedB), source=0.0) if (present(alloc_faces)) then ; if (alloc_faces) then - allocate(BT_cont%h_u(IsdB:IedB,jsd:jed,1:nz)) ; BT_cont%h_u(:,:,:) = 0.0 - allocate(BT_cont%h_v(isd:ied,JsdB:JedB,1:nz)) ; BT_cont%h_v(:,:,:) = 0.0 + allocate(BT_cont%h_u(IsdB:IedB,jsd:jed,1:nz), source=0.0) + allocate(BT_cont%h_v(isd:ied,JsdB:JedB,1:nz), source=0.0) endif ; endif end subroutine alloc_BT_cont_type diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 7495e0033b..46fbd55862 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -173,8 +173,8 @@ subroutine verticalGridInit( param_file, GV, US ) allocate( GV%sInterface(nk+1) ) allocate( GV%sLayer(nk) ) - allocate( GV%g_prime(nk+1) ) ; GV%g_prime(:) = 0.0 - allocate( GV%Rlay(nk) ) ; GV%Rlay(:) = 0.0 + allocate( GV%g_prime(nk+1), source=0.0 ) + allocate( GV%Rlay(nk), source=0.0 ) end subroutine verticalGridInit diff --git a/src/core/_Finite_difference.dox b/src/core/_Finite_difference.dox deleted file mode 100644 index ecbd37d8b7..0000000000 --- a/src/core/_Finite_difference.dox +++ /dev/null @@ -1,5 +0,0 @@ -/*! \page Finite_Difference_Operators Finite Difference Operators - -\brief Finite Difference Operators - -*/ diff --git a/src/core/_Sea_ice.dox b/src/core/_Sea_ice.dox index bec05af17c..232bac1bb8 100644 --- a/src/core/_Sea_ice.dox +++ b/src/core/_Sea_ice.dox @@ -1,5 +1,11 @@ /*! \page Sea_Ice Sea Ice Considerations -\section Frazil Ice Formation +\section section_seaice Sea Ice Considerations + +For realistic domains, it is assumed that MOM6 will be run in a coupled mode, such that either the +sea-ice model or the coupler will be computing atmospheric bulk fluxes and passing them to the ocean. +Likewise, MOM6 can compute the frazil ice formation as described in \ref section_frazil, which it +then passes to the sea-ice model, expecting to get back the rejected brine or melted fresh water in +return. */ diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 45b08cc799..b5a1a6bf0c 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -248,13 +248,13 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i,j) + e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i+1,j) + e(nz+1) = -US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -331,7 +331,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp (0.5*US%L_T_to_m_s*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) + write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) ! From here on, the normalized accelerations are written. if (prev_avail) then @@ -584,13 +584,13 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp write(file,'(/,"h++: ",$)') do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i,j) + e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k); enddo write(file,'(/,"e-: ",$)') write(file,'(ES10.3," ",$)') e(ks) do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K); enddo - e(nz+1) = -US%Z_to_m*G%bathyT(i,j+1) + e(nz+1) = -US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo write(file,'(/,"e+: ",$)') write(file,'(ES10.3," ",$)') e(ks) @@ -667,7 +667,7 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt_in_T, G, GV, US, CS, vel_rp (CS%u_prev(I,j+1,k) * h_scale*0.5*(hin(i,j+1,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,j+1) + write(file,'(/,"D: ",2(ES10.3))') US%Z_to_m*(G%bathyT(i,j) + G%Z_ref), US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) ! From here on, the normalized accelerations are written. if (prev_avail) then diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e6b01af33d..b3041f5afb 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -107,6 +107,7 @@ module MOM_diagnostics !! of this spurious Coriolis source. KE_adv => NULL(), & !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] KE_visc => NULL(), & !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] + KE_stress => NULL(), & !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] KE_horvisc => NULL(), & !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] KE_dia => NULL() !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] @@ -121,8 +122,8 @@ module MOM_diagnostics integer :: id_col_ht = -1, id_dh_dt = -1 integer :: id_KE = -1, id_dKEdt = -1 integer :: id_PE_to_KE = -1, id_KE_BT = -1 - integer :: id_KE_Coradv = -1 - integer :: id_KE_adv = -1, id_KE_visc = -1 + integer :: id_KE_Coradv = -1, id_KE_adv = -1 + integer :: id_KE_visc = -1, id_KE_stress = -1 integer :: id_KE_horvisc = -1, id_KE_dia = -1 integer :: id_uh_Rlay = -1, id_vh_Rlay = -1 integer :: id_uhGM_Rlay = -1, id_vhGM_Rlay = -1 @@ -385,14 +386,14 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & endif if (associated(CS%e)) then - call find_eta(h, tv, G, GV, US, CS%e) + call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) endif if (associated(CS%e_D)) then if (associated(CS%e)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + G%bathyT(i,j) + CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo else call find_eta(h, tv, G, GV, US, CS%e_D) @@ -1060,7 +1061,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_h(i,j) = CS%KE(i,j,k) * CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & - call do_group_pass(CS%pass_KE_uv, G%domain) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%dKE_dt(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1078,7 +1079,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = 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) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%PE_to_KE(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1096,7 +1097,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%v_accel_bt(i,J,k) enddo ; enddo if (.not.G%symmetric) & - call do_group_pass(CS%pass_KE_uv, G%domain) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%KE_BT(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1118,7 +1119,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS * (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) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%KE_CorAdv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1146,7 +1147,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS * (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) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%KE_adv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1164,7 +1165,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = 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) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%KE_visc(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1173,6 +1174,24 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) endif + if (associated(CS%KE_stress)) 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_str(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_str(i,J,k) + enddo ; enddo + if (.not.G%symmetric) & + call do_group_pass(CS%pass_KE_uv, G%domain) + do j=js,je ; do i=is,ie + CS%KE_stress(i,j,k) = 0.5 * G%IareaT(i,j) * & + ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1))) + enddo ; enddo + enddo + if (CS%id_KE_stress > 0) call post_data(CS%id_KE_stress, CS%KE_stress, CS%diag) + endif + if (associated(CS%KE_horvisc)) then do k=1,nz do j=js,je ; do I=Isq,Ieq @@ -1182,7 +1201,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%diffv(i,J,k) enddo ; enddo if (.not.G%symmetric) & - call do_group_pass(CS%pass_KE_uv, G%domain) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%KE_horvisc(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1203,7 +1222,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_h(i,j) = CS%KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) enddo ; enddo if (.not.G%symmetric) & - call do_group_pass(CS%pass_KE_uv, G%domain) + call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie CS%KE_dia(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) @@ -1894,6 +1913,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) if (CS%id_KE_visc>0) call safe_alloc_ptr(CS%KE_visc,isd,ied,jsd,jed,nz) + CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & + 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + if (CS%id_KE_stress>0) call safe_alloc_ptr(CS%KE_stress,isd,ied,jsd,jed,nz) + CS%id_KE_horvisc = register_diag_field('ocean_model', 'KE_horvisc', diag%axesTL, Time, & 'Kinetic Energy Source from Horizontal Viscosity', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) @@ -2108,7 +2132,8 @@ subroutine write_static_fields(G, GV, US, tv, diag) type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output ! Local variables - integer :: id + real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. + integer :: id, i, j logical :: use_temperature id = register_static_field('ocean_model', 'geolat', diag%axesT1, & @@ -2180,7 +2205,10 @@ subroutine write_static_fields(G, GV, US, tv, diag) cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & cmor_standard_name='sea_floor_depth_below_geoid', area=diag%axesT1%id_area, & x_cell_method='mean', y_cell_method='mean', area_cell_method='mean') - if (id > 0) call post_data(id, G%bathyT, diag, .true., mask=G%mask2dT) + if (id > 0) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; work_2d(i,j) = G%bathyT(i,j)+G%Z_ref ; enddo ; enddo + call post_data(id, work_2d, diag, .true., mask=G%mask2dT) + endif id = register_static_field('ocean_model', 'wet', diag%axesT1, & '0 if land, 1 if ocean at tracer points', 'none', area=diag%axesT1%id_area) @@ -2294,7 +2322,7 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) if (associated(CS%dKE_dt) .or. associated(CS%PE_to_KE) .or. & associated(CS%KE_BT) .or. associated(CS%KE_CorAdv) .or. & - associated(CS%KE_adv) .or. associated(CS%KE_visc) .or. & + associated(CS%KE_adv) .or. associated(CS%KE_visc) .or. associated(CS%KE_stress) .or. & associated(CS%KE_horvisc) .or. associated(CS%KE_dia)) & call safe_alloc_ptr(CS%KE,isd,ied,jsd,jed,nz) @@ -2317,12 +2345,16 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (associated(CS%KE_visc)) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif + if (associated(CS%KE_stress)) then + call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) + endif + if (associated(CS%KE_dia)) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) @@ -2353,6 +2385,7 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) if (associated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) if (associated(CS%KE_adv)) deallocate(CS%KE_adv) if (associated(CS%KE_visc)) deallocate(CS%KE_visc) + if (associated(CS%KE_stress)) deallocate(CS%KE_stress) if (associated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) if (associated(CS%KE_dia)) deallocate(CS%KE_dia) if (associated(CS%dv_dt)) deallocate(CS%dv_dt) @@ -2365,9 +2398,11 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) if (associated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) - if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) + if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) if (associated(ADp%du_dt_visc)) deallocate(ADp%du_dt_visc) if (associated(ADp%dv_dt_visc)) deallocate(ADp%dv_dt_visc) + if (associated(ADp%du_dt_str)) deallocate(ADp%du_dt_str) + if (associated(ADp%dv_dt_str)) deallocate(ADp%dv_dt_str) if (associated(ADp%du_dt_dia)) deallocate(ADp%du_dt_dia) if (associated(ADp%dv_dt_dia)) deallocate(ADp%dv_dt_dia) if (associated(ADp%du_other)) deallocate(ADp%du_other) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 72523edfd3..d190cee7a3 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -542,7 +542,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ enddo ; enddo ; enddo mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) - call find_eta(h, tv, G, GV, US, eta) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = US%Z_to_m*US%L_to_m**2*(eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo @@ -674,8 +674,8 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ hbelow = 0.0 do k=nz,1,-1 hbelow = hbelow + h(i,j,k) * GV%H_to_Z - hint = Z_0APE(K) + (hbelow - G%bathyT(i,j)) - hbot = Z_0APE(K) - G%bathyT(i,j) + hint = Z_0APE(K) + (hbelow - (G%bathyT(i,j) + G%Z_ref)) + hbot = Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref) hbot = (hbot + ABS(hbot)) * 0.5 PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j)) * (GV%Rho0*GV%g_prime(K)) * & (hint * hint - hbot * hbot) @@ -685,7 +685,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, OBC, dt_ do j=js,je ; do i=is,ie 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) + hbot = max(Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref), 0.0) PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & (hint * hint - hbot * hbot) enddo @@ -1166,7 +1166,7 @@ subroutine create_depth_list(G, DL, min_depth_inc) i_global = i + G%idg_offset - (G%isg-1) list_pos = (j_global-1)*G%Domain%niglobal + i_global - Dlist(list_pos) = G%bathyT(i,j) + Dlist(list_pos) = G%bathyT(i,j) + G%Z_ref Arealist(list_pos) = G%mask2dT(i,j) * G%areaT(i,j) enddo ; enddo @@ -1401,7 +1401,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Depth checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%bathyT(i,j) + field(i,j) = G%bathyT(i,j) + G%Z_ref enddo ; enddo write(depth_chksum, '(Z16)') field_chksum(field(:,:)) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 035386f92d..6a4d9660d7 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -444,7 +444,8 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - if ( ((G%bathyT(i,j)-sum_hc < l_mono_N2_column_fraction*G%bathyT(i,j)) .or. & + !### Change to: if ( ((htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) .or. & ) ) + if ( (((G%bathyT(i,j)+G%Z_ref) - sum_hc < l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) .or. & ((l_mono_N2_depth >= 0.) .and. (sum_hc > l_mono_N2_depth))) .and. & (L2_to_Z2*gp > N2min*hw) ) then ! Filters out regions where N2 increases with depth but only in a lower fraction diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 6e74c3ffa3..23f22d8a24 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1253,7 +1253,7 @@ end subroutine analytic_int_specific_vol_dp !! pressure anomalies across layers, which are required for calculating the !! finite-volume form pressure accelerations in a Boussinesq model. subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, dpa, & - intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp) + intz_dpa, intx_dpa, inty_dpa, bathyT, dz_neglect, useMassWghtInterp, Z_0p) type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structure real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature referenced to the surface [degC] @@ -1292,6 +1292,8 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, real, optional, intent(in) :: dz_neglect !< A miniscule thickness change [Z ~> m] logical, optional, intent(in) :: useMassWghtInterp !< If true, uses mass weighting to !! interpolate T/S for top and bottom integrals. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] + ! Local variables real :: rho_scale ! A multiplicative factor by which to scale density from kg m-3 to the ! desired units [R m3 kg-1 ~> 1] @@ -1322,11 +1324,11 @@ subroutine analytic_int_density_dz(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, EOS, if ((rho_scale /= 1.0) .or. (pres_scale /= 1.0)) then call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & - dz_neglect, useMassWghtInterp, rho_scale, pres_scale) + dz_neglect, useMassWghtInterp, rho_scale, pres_scale, Z_0p=Z_0p) else call int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dpa, intz_dpa, intx_dpa, inty_dpa, bathyT, & - dz_neglect, useMassWghtInterp) + dz_neglect, useMassWghtInterp, Z_0p=Z_0p) endif case default call MOM_error(FATAL, "No analytic integration option is available with this EOS!") diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index e5cc9555b7..730687fbf6 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -408,7 +408,7 @@ end subroutine calculate_compress_wright !! finite-volume form pressure accelerations in a Boussinesq model. subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & dpa, intz_dpa, intx_dpa, inty_dpa, & - bathyT, dz_neglect, useMassWghtInterp, rho_scale, pres_scale) + bathyT, dz_neglect, useMassWghtInterp, rho_scale, pres_scale, Z_0p) type(hor_index_type), intent(in) :: HI !< The horizontal index type for the arrays. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: T !< Potential temperature relative to the surface @@ -451,6 +451,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & !! from kg m-3 to the desired units [R m3 kg-1 ~> 1] real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure !! into Pa [Pa T2 R-1 L-2 ~> 1]. + real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! Local variables real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d, p0_2d, lambda_2d @@ -461,7 +462,8 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: g_Earth ! The gravitational acceleration [m2 Z-1 s-2 ~> m s-2] real :: I_Rho ! The inverse of the Boussinesq density [m3 kg-1] real :: rho_ref_mks ! The reference density in MKS units, never rescaled from kg m-3 [kg m-3] - real :: p_ave, I_al0, I_Lzz + real :: p_ave ! The layer averaged pressure [Pa] + real :: I_al0, I_Lzz real :: dz ! The layer thickness [Z ~> m]. real :: hWght ! A pressure-thickness below topography [Z ~> m]. real :: hL, hR ! Pressure-thicknesses of the columns to the left and right [Z ~> m]. @@ -470,10 +472,11 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: hWt_RL, hWt_RR ! hWt_RA is the weighted influence of A on the right column [nondim]. real :: wt_L, wt_R ! The linear weights of the left and right columns [nondim]. real :: wtT_L, wtT_R ! The weights for tracers from the left and right columns [nondim]. - real :: intz(5) ! The integrals of density with height at the - ! 5 sub-column locations [R L2 T-2 ~> Pa]. + real :: intz(5) ! The gravitational acceleration times the integrals of density + ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] or [Pa]. real :: Pa_to_RL2_T2 ! A conversion factor of pressures from Pa to the output units indicated by ! pres_scale [R L2 T-2 Pa-1 ~> 1] or [1]. + real :: z0pres ! The height at which the pressure is zero [Z ~> m] logical :: do_massWeight ! Indicates whether to do mass weighting. real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants. real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants. @@ -499,6 +502,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & else rho_ref_mks = rho_ref ; I_Rho = 1.0 / rho_0 endif + z0pres = 0.0 ; if (present(Z_0p)) z0pres = Z_0p do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then @@ -517,7 +521,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & al0 = al0_2d(i,j) ; p0 = p0_2d(i,j) ; lambda = lambda_2d(i,j) dz = z_t(i,j) - z_b(i,j) - p_ave = -0.5*GxRho*(z_t(i,j)+z_b(i,j)) + p_ave = -GxRho*(0.5*(z_t(i,j)+z_b(i,j)) - z0pres) I_al0 = 1.0 / al0 I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave) @@ -561,8 +565,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i+1,j) - z_b(i+1,j)) - p_ave = -0.5*GxRho*(wt_L*(z_t(i,j)+z_b(i,j)) + & - wt_R*(z_t(i+1,j)+z_b(i+1,j))) + p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i+1,j)+z_b(i+1,j))) - z0pres) I_al0 = 1.0 / al0 I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave) @@ -603,8 +606,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i,j+1) dz = wt_L*(z_t(i,j) - z_b(i,j)) + wt_R*(z_t(i,j+1) - z_b(i,j+1)) - p_ave = -0.5*GxRho*(wt_L*(z_t(i,j)+z_b(i,j)) + & - wt_R*(z_t(i,j+1)+z_b(i,j+1))) + p_ave = -GxRho*(0.5*(wt_L*(z_t(i,j)+z_b(i,j)) + wt_R*(z_t(i,j+1)+z_b(i,j+1))) - z0pres) I_al0 = 1.0 / al0 I_Lzz = 1.0 / (p0 + (lambda * I_al0) + p_ave) diff --git a/src/equation_of_state/_Equation_of_State.dox b/src/equation_of_state/_Equation_of_State.dox index 2e18b49f54..791c7001b1 100644 --- a/src/equation_of_state/_Equation_of_State.dox +++ b/src/equation_of_state/_Equation_of_State.dox @@ -36,7 +36,7 @@ Compute the required quantities using the equation of state from \cite jackett19 Compute the required quantities using the equation of state from [TEOS-10](http://www.teos-10.org/). -\section TFREEZE Freezing Temperature of Sea Water +\section section_TFREEZE Freezing Temperature of Sea Water There are three choices for computing the freezing point of sea water: diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 7b073e8a0b..718a796802 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -151,8 +151,7 @@ subroutine zchksum(array, mesg, scale, logunit) if (calculateStatistics) then if (present(scale)) then - allocate(rescaled_array(LBOUND(array,1):UBOUND(array,1))) - rescaled_array(:) = 0.0 + allocate(rescaled_array(LBOUND(array,1):UBOUND(array,1)), source=0.0) do k=1, size(array, 1) rescaled_array(k) = scale * array(k) enddo @@ -358,8 +357,7 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec rescaled_array(i,j) = scale*array(i,j) enddo ; enddo @@ -627,8 +625,7 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do J=Js,HI%JecB ; do I=Is,HI%IecB @@ -911,8 +908,7 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 do j=HI%jsc,HI%jec ; do I=Is,HI%IecB rescaled_array(I,j) = scale*array(I,j) @@ -1090,8 +1086,7 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do J=Js,HI%JecB ; do i=HI%isc,HI%iec rescaled_array(i,J) = scale*array(i,J) @@ -1257,8 +1252,7 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec rescaled_array(i,j,k) = scale*array(i,j,k) enddo ; enddo ; enddo @@ -1411,8 +1405,7 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do k=1,size(array,3) ; do J=Js,HI%JecB ; do I=Is,HI%IecB @@ -1591,8 +1584,7 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do I=Is,HI%IecB rescaled_array(I,j,k) = scale*array(I,j,k) @@ -1770,8 +1762,7 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do k=1,size(array,3) ; do J=Js,HI%JecB ; do i=HI%isc,HI%iec rescaled_array(i,J,k) = scale*array(i,J,k) @@ -1921,7 +1912,7 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) enddo pe_num = pe_here() + 1 - root_pe() ; nPEs = num_pes() - allocate(sum_here(nPEs)) ; sum_here(:) = 0.0 ; sum_here(pe_num) = sum + allocate(sum_here(nPEs), source=0.0) ; sum_here(pe_num) = sum call sum_across_PEs(sum_here,nPEs) sum1 = sum_bc diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index e068d26f5d..374f54548e 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -764,7 +764,7 @@ subroutine set_masks_for_axes(G, diag_cs) ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) nk = axes%nz - allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk), source=0. ) call diag_remap_calc_hmask(diag_cs%diag_remap_cs(c), G, axes%mask3d) h_axes => diag_cs%remap_axesTL(c) ! Use the h-point masks to generate the u-, v- and q- masks @@ -773,7 +773,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCuL(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at u-layers') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk), source=0. ) do k = 1, nk ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo @@ -782,7 +782,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCvL(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at v-layers') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk), source=0. ) do k = 1, nk ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo @@ -791,7 +791,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesBL(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at q-layers') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk), source=0. ) do k = 1, nk ; do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. @@ -801,7 +801,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesTi(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at h-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk+1), source=0. ) do J=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 if (h_axes%mask3d(i,j,1) > 0.) axes%mask3d(i,J,1) = 1. do K = 2, nk @@ -816,7 +816,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCui(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at u-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk+1), source=0. ) do k = 1, nk+1 ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo @@ -825,7 +825,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCvi(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at v-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk+1), source=0. ) do k = 1, nk+1 ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo @@ -834,7 +834,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesBi(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at q-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk+1), source=0. ) do k = 1, nk ; do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. @@ -1969,10 +1969,10 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value - type(diag_ctrl), pointer :: diag_cs => NULL() - type(axes_grp), pointer :: remap_axes => null() - type(axes_grp), pointer :: axes => null() - type(axes_grp), pointer :: axes_d2 => null() + type(diag_ctrl), pointer :: diag_cs + type(axes_grp), pointer :: remap_axes + type(axes_grp), pointer :: axes + type(axes_grp), pointer :: axes_d2 integer :: dm_id, i, dl character(len=256) :: msg, cm_string character(len=256) :: new_module_name @@ -2097,8 +2097,8 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time new_module_name = trim(module_name)//'_d2' + axes_d2 => null() if (axes_in%rank == 3 .or. axes_in%rank == 2 ) then - axes_d2 => null() if (axes_in%id == diag_cs%axesTL%id) then axes_d2 => diag_cs%dsamp(dl)%axesTL elseif (axes_in%id == diag_cs%axesBL%id) then @@ -2129,6 +2129,7 @@ integer function register_diag_field(module_name, field_name, axes_in, init_time //trim(new_module_name)//"-"//trim(field_name)) endif endif + ! Register the native diagnostic if (associated(axes_d2)) then active = register_diag_field_expand_cmor(dm_id, new_module_name, field_name, axes_d2, & @@ -3473,16 +3474,18 @@ subroutine diag_mediator_end(time, diag_CS, end_diag_manager) call axes_grp_end(diag_cs%remap_axesCvi(i)) enddo - deallocate(diag_cs%remap_axesZL) - deallocate(diag_cs%remap_axesZi) - deallocate(diag_cs%remap_axesTL) - deallocate(diag_cs%remap_axesTi) - deallocate(diag_cs%remap_axesBL) - deallocate(diag_cs%remap_axesBi) - deallocate(diag_cs%remap_axesCuL) - deallocate(diag_cs%remap_axesCui) - deallocate(diag_cs%remap_axesCvL) - deallocate(diag_cs%remap_axesCvi) + if (diag_cs%num_diag_coords > 0) then + deallocate(diag_cs%remap_axesZL) + deallocate(diag_cs%remap_axesZi) + deallocate(diag_cs%remap_axesTL) + deallocate(diag_cs%remap_axesTi) + deallocate(diag_cs%remap_axesBL) + deallocate(diag_cs%remap_axesBi) + deallocate(diag_cs%remap_axesCuL) + deallocate(diag_cs%remap_axesCui) + deallocate(diag_cs%remap_axesCvL) + deallocate(diag_cs%remap_axesCvi) + endif do dl=2,MAX_DSAMP_LEV if (allocated(diag_cs%dsamp(dl)%remap_axesTL)) & diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index d3eb21dcbe..bb11d92673 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -321,22 +321,22 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe if (remap_cs%vertical_coord == coordinateMode('ZSTAR')) then call build_zstar_column(get_zlike_CS(remap_cs%regrid_cs), & - GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), & + GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), & zInterfaces, zScale=GV%Z_to_H) elseif (remap_cs%vertical_coord == coordinateMode('SIGMA')) then call build_sigma_column(get_sigma_CS(remap_cs%regrid_cs), & - GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) + GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) elseif (remap_cs%vertical_coord == coordinateMode('RHO')) then call build_rho_column(get_rho_CS(remap_cs%regrid_cs), GV%ke, & - GV%Z_to_H*G%bathyT(i,j), h(i,j,:), T(i,j,:), S(i,j,:), & + GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), h(i,j,:), T(i,j,:), S(i,j,:), & eqn_of_state, zInterfaces, h_neglect, h_neglect_edge) elseif (remap_cs%vertical_coord == coordinateMode('SLIGHT')) then ! call build_slight_column(remap_cs%regrid_cs,remap_cs%remap_cs, nz, & -! GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: SLIGHT coordinate not coded for diagnostics yet!") elseif (remap_cs%vertical_coord == coordinateMode('HYCOM1')) then ! call build_hycom1_column(remap_cs%regrid_cs, nz, & -! GV%Z_to_H*G%bathyT(i,j), sum(h(i,j,:)), zInterfaces) +! GV%Z_to_H*(G%bathyT(i,j)+G%Z_ref), sum(h(i,j,:)), zInterfaces) call MOM_error(FATAL,"diag_remap_update: HYCOM1 coordinate not coded for diagnostics yet!") endif do k = 1,nz diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 2a9a381caa..43aeb3372a 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -211,71 +211,71 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg - allocate(G%dxT(isd:ied,jsd:jed)) ; G%dxT(:,:) = 0.0 - allocate(G%dxCu(IsdB:IedB,jsd:jed)) ; G%dxCu(:,:) = 0.0 - allocate(G%dxCv(isd:ied,JsdB:JedB)) ; G%dxCv(:,:) = 0.0 - allocate(G%dxBu(IsdB:IedB,JsdB:JedB)) ; G%dxBu(:,:) = 0.0 - allocate(G%IdxT(isd:ied,jsd:jed)) ; G%IdxT(:,:) = 0.0 - allocate(G%IdxCu(IsdB:IedB,jsd:jed)) ; G%IdxCu(:,:) = 0.0 - allocate(G%IdxCv(isd:ied,JsdB:JedB)) ; G%IdxCv(:,:) = 0.0 - allocate(G%IdxBu(IsdB:IedB,JsdB:JedB)) ; G%IdxBu(:,:) = 0.0 - - allocate(G%dyT(isd:ied,jsd:jed)) ; G%dyT(:,:) = 0.0 - allocate(G%dyCu(IsdB:IedB,jsd:jed)) ; G%dyCu(:,:) = 0.0 - allocate(G%dyCv(isd:ied,JsdB:JedB)) ; G%dyCv(:,:) = 0.0 - allocate(G%dyBu(IsdB:IedB,JsdB:JedB)) ; G%dyBu(:,:) = 0.0 - allocate(G%IdyT(isd:ied,jsd:jed)) ; G%IdyT(:,:) = 0.0 - allocate(G%IdyCu(IsdB:IedB,jsd:jed)) ; G%IdyCu(:,:) = 0.0 - allocate(G%IdyCv(isd:ied,JsdB:JedB)) ; G%IdyCv(:,:) = 0.0 - allocate(G%IdyBu(IsdB:IedB,JsdB:JedB)) ; G%IdyBu(:,:) = 0.0 - - allocate(G%areaT(isd:ied,jsd:jed)) ; G%areaT(:,:) = 0.0 - allocate(G%IareaT(isd:ied,jsd:jed)) ; G%IareaT(:,:) = 0.0 - allocate(G%areaBu(IsdB:IedB,JsdB:JedB)) ; G%areaBu(:,:) = 0.0 - allocate(G%IareaBu(IsdB:IedB,JsdB:JedB)) ; G%IareaBu(:,:) = 0.0 - - allocate(G%mask2dT(isd:ied,jsd:jed)) ; G%mask2dT(:,:) = 0.0 - allocate(G%mask2dCu(IsdB:IedB,jsd:jed)) ; G%mask2dCu(:,:) = 0.0 - allocate(G%mask2dCv(isd:ied,JsdB:JedB)) ; G%mask2dCv(:,:) = 0.0 - allocate(G%mask2dBu(IsdB:IedB,JsdB:JedB)) ; G%mask2dBu(:,:) = 0.0 - allocate(G%geoLatT(isd:ied,jsd:jed)) ; G%geoLatT(:,:) = 0.0 - allocate(G%geoLatCu(IsdB:IedB,jsd:jed)) ; G%geoLatCu(:,:) = 0.0 - allocate(G%geoLatCv(isd:ied,JsdB:JedB)) ; G%geoLatCv(:,:) = 0.0 - allocate(G%geoLatBu(IsdB:IedB,JsdB:JedB)) ; G%geoLatBu(:,:) = 0.0 - allocate(G%geoLonT(isd:ied,jsd:jed)) ; G%geoLonT(:,:) = 0.0 - allocate(G%geoLonCu(IsdB:IedB,jsd:jed)) ; G%geoLonCu(:,:) = 0.0 - allocate(G%geoLonCv(isd:ied,JsdB:JedB)) ; G%geoLonCv(:,:) = 0.0 - allocate(G%geoLonBu(IsdB:IedB,JsdB:JedB)) ; G%geoLonBu(:,:) = 0.0 - - allocate(G%dx_Cv(isd:ied,JsdB:JedB)) ; G%dx_Cv(:,:) = 0.0 - allocate(G%dy_Cu(IsdB:IedB,jsd:jed)) ; G%dy_Cu(:,:) = 0.0 - - allocate(G%areaCu(IsdB:IedB,jsd:jed)) ; G%areaCu(:,:) = 0.0 - allocate(G%areaCv(isd:ied,JsdB:JedB)) ; G%areaCv(:,:) = 0.0 - allocate(G%IareaCu(IsdB:IedB,jsd:jed)) ; G%IareaCu(:,:) = 0.0 - allocate(G%IareaCv(isd:ied,JsdB:JedB)) ; G%IareaCv(:,:) = 0.0 - - allocate(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = 0.0 - allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB)) ; G%CoriolisBu(:,:) = 0.0 - allocate(G%dF_dx(isd:ied, jsd:jed)) ; G%dF_dx(:,:) = 0.0 - allocate(G%dF_dy(isd:ied, jsd:jed)) ; G%dF_dy(:,:) = 0.0 - - allocate(G%sin_rot(isd:ied,jsd:jed)) ; G%sin_rot(:,:) = 0.0 - allocate(G%cos_rot(isd:ied,jsd:jed)) ; G%cos_rot(:,:) = 1.0 + allocate(G%dxT(isd:ied,jsd:jed), source=0.0) + allocate(G%dxCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%dxCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%dxBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%IdxT(isd:ied,jsd:jed), source=0.0) + allocate(G%IdxCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IdxCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IdxBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%dyT(isd:ied,jsd:jed), source=0.0) + allocate(G%dyCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%dyCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%dyBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%IdyT(isd:ied,jsd:jed), source=0.0) + allocate(G%IdyCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IdyCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IdyBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%areaT(isd:ied,jsd:jed), source=0.0) + allocate(G%IareaT(isd:ied,jsd:jed), source=0.0) + allocate(G%areaBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%IareaBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%mask2dT(isd:ied,jsd:jed), source=0.0) + allocate(G%mask2dCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%mask2dCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%mask2dBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%geoLatT(isd:ied,jsd:jed), source=0.0) + allocate(G%geoLatCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%geoLatCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%geoLatBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%geoLonT(isd:ied,jsd:jed), source=0.0) + allocate(G%geoLonCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%geoLonCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%geoLonBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%dx_Cv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%dy_Cu(IsdB:IedB,jsd:jed), source=0.0) + + allocate(G%areaCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%areaCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IareaCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IareaCv(isd:ied,JsdB:JedB), source=0.0) + + allocate(G%bathyT(isd:ied, jsd:jed), source=0.0) + allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB), source=0.0) + allocate(G%dF_dx(isd:ied, jsd:jed), source=0.0) + allocate(G%dF_dy(isd:ied, jsd:jed), source=0.0) + + allocate(G%sin_rot(isd:ied,jsd:jed), source=0.0) + allocate(G%cos_rot(isd:ied,jsd:jed), source=1.0) if (G%bathymetry_at_vel) then - allocate(G%Dblock_u(IsdB:IedB, jsd:jed)) ; G%Dblock_u(:,:) = 0.0 - allocate(G%Dopen_u(IsdB:IedB, jsd:jed)) ; G%Dopen_u(:,:) = 0.0 - allocate(G%Dblock_v(isd:ied, JsdB:JedB)) ; G%Dblock_v(:,:) = 0.0 - allocate(G%Dopen_v(isd:ied, JsdB:JedB)) ; G%Dopen_v(:,:) = 0.0 + allocate(G%Dblock_u(IsdB:IedB, jsd:jed), source=0.0) + allocate(G%Dopen_u(IsdB:IedB, jsd:jed), source=0.0) + allocate(G%Dblock_v(isd:ied, JsdB:JedB), source=0.0) + allocate(G%Dopen_v(isd:ied, JsdB:JedB), source=0.0) endif ! gridLonB and gridLatB are used as edge values in some cases, so they ! always need to use symmetric memory allcoations. - allocate(G%gridLonT(isg:ieg)) ; G%gridLonT(:) = 0.0 - allocate(G%gridLonB(isg-1:ieg)) ; G%gridLonB(:) = 0.0 - allocate(G%gridLatT(jsg:jeg)) ; G%gridLatT(:) = 0.0 - allocate(G%gridLatB(jsg-1:jeg)) ; G%gridLatB(:) = 0.0 + allocate(G%gridLonT(isg:ieg), source=0.0) + allocate(G%gridLonB(isg-1:ieg), source=0.0) + allocate(G%gridLatT(jsg:jeg), source=0.0) + allocate(G%gridLatB(jsg-1:jeg), source=0.0) end subroutine create_dyn_horgrid @@ -294,9 +294,9 @@ subroutine rescale_dyn_horgrid_bathymetry(G, m_in_new_units) if (m_in_new_units == 1.0) return if (m_in_new_units < 0.0) & - call MOM_error(FATAL, "rescale_grid_bathymetry: Negative depth units are not permitted.") + call MOM_error(FATAL, "rescale_dyn_horgrid_bathymetry: Negative depth units are not permitted.") if (m_in_new_units == 0.0) & - call MOM_error(FATAL, "rescale_grid_bathymetry: Zero depth units are not permitted.") + call MOM_error(FATAL, "rescale_dyn_horgrid_bathymetry: Zero depth units are not permitted.") rescale = 1.0 / m_in_new_units do j=jsd,jed ; do i=isd,ied diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index d1a4b7f45d..0f16a5b301 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -9,6 +9,7 @@ module MOM_horizontal_regridding use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint +use MOM_error_handler, only : MOM_get_verbosity use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_interpolate, only : time_interp_external, horiz_interp_init @@ -263,12 +264,16 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, intent(in) :: conversion !< Conversion factor for tracer. integer, intent(in) :: recnum !< Record number of tracer to be read. type(ocean_grid_type), intent(inout) :: G !< Grid object - real, allocatable, dimension(:,:,:) :: tr_z !< pointer to allocatable tracer array on local + real, allocatable, dimension(:,:,:), intent(out) :: tr_z + !< pointer to allocatable tracer array on local !! model grid and input-file vertical levels. - real, allocatable, dimension(:,:,:) :: mask_z !< pointer to allocatable tracer mask array on + real, allocatable, dimension(:,:,:), intent(out) :: mask_z + !< pointer to allocatable tracer mask array on !! local model grid and input-file vertical levels. - real, allocatable, dimension(:) :: z_in !< Cell grid values for input data. - real, allocatable, dimension(:) :: z_edges_in !< Cell grid edge values for input data. + real, allocatable, dimension(:), intent(out) :: z_in + !< Cell grid values for input data. + real, allocatable, dimension(:), intent(out) :: z_edges_in + !< Cell grid edge values for input data. real, intent(out) :: missing_value !< The missing value in the returned array. logical, intent(in) :: reentrant_x !< If true, this grid is reentrant in the x-direction logical, intent(in) :: tripolar_n !< If true, this is a northern tripolar grid @@ -329,10 +334,6 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid - if (allocated(tr_z)) deallocate(tr_z) - if (allocated(mask_z)) deallocate(mask_z) - if (allocated(z_edges_in)) deallocate(z_edges_in) - PI_180 = atan(1.0)/45. ! Open NetCDF file and if present, extract data and spatial coordinate information @@ -383,13 +384,6 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, 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) - if (allocated(z_edges_in)) deallocate(z_edges_in) - if (allocated(tr_z)) deallocate(tr_z) - if (allocated(mask_z)) deallocate(mask_z) - allocate(lon_in(id), lat_in(jd), z_in(kd), z_edges_in(kd+1)) allocate(tr_z(isd:ied,jsd:jed,kd), mask_z(isd:ied,jsd:jed,kd)) @@ -435,8 +429,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, z_edges_in(kd+1) = 2.0*z_in(kd) - z_in(kd-1) if (is_ongrid) then - allocate(tr_in(is:ie,js:je)) ; tr_in(:,:)=0.0 - allocate(mask_in(is:ie,js:je)) ; mask_in(:,:)=0.0 + allocate(tr_in(is:ie,js:je), source=0.0) + allocate(mask_in(is:ie,js:je), source=0.0) else call horiz_interp_init() lon_in = lon_in*PI_180 @@ -445,15 +439,15 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call meshgrid(lon_in, lat_in, x_in, y_in) lon_out(:,:) = G%geoLonT(:,:)*PI_180 lat_out(:,:) = G%geoLatT(:,:)*PI_180 - allocate(tr_in(id,jd)) ; tr_in(:,:) = 0.0 - allocate(tr_inp(id,jdp)) ; tr_inp(:,:) = 0.0 - allocate(mask_in(id,jdp)) ; mask_in(:,:) = 0.0 + allocate(tr_in(id,jd), source=0.0) + allocate(tr_inp(id,jdp), source=0.0) + allocate(mask_in(id,jdp), source=0.0) endif - max_depth = maxval(G%bathyT) + max_depth = maxval(G%bathyT(:,:)) + G%Z_ref call max_across_PEs(max_depth) - if (z_edges_in(kd+1)5), turns=turns) ! Loop through each data level and interpolate to model grid. ! After interpolating, fill in points which will be needed to define the layers. do k=1,kd @@ -842,7 +838,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t nPoints = nPoints + 1 varAvg = varAvg + tr_out(i,j) endif - if ((G%mask2dT(i,j) == 1.0) .and. (z_edges_in(k) <= G%bathyT(i,j)) .and. & + if ((G%mask2dT(i,j) == 1.0) .and. (z_edges_in(k) <= G%bathyT(i,j) + G%Z_ref) .and. & (mask_out(i,j) < 1.0)) & fill(i,j) = 1.0 enddo ; enddo @@ -888,7 +884,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd else - call time_interp_external(fms_id, Time, data_in, verbose=.true., turns=turns) + call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>5), turns=turns) do k=1,kd do j=js,je do i=is,ie @@ -899,7 +895,6 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo enddo endif - end subroutine horiz_interp_and_extrap_tracer_fms_id !> Create a 2d-mesh of grid coordinates from 1-d arrays. diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index f8cfb09382..00eeb4cf89 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -4,6 +4,7 @@ module MOM_io ! This file is part of MOM6. See LICENSE.md for the license. use MOM_array_transform, only : allocate_rotated_array, rotate_array +use MOM_array_transform, only : rotate_array_pair, rotate_vector use MOM_domains, only : MOM_domain_type, domain1D, broadcast, get_domain_components use MOM_domains, only : rescale_comp_data, AGRID, BGRID_NE, CGRID_NE use MOM_dyn_horgrid, only : dyn_horgrid_type @@ -11,8 +12,9 @@ module MOM_io use MOM_error_handler, only : MOM_error, NOTE, FATAL, WARNING, is_root_PE use MOM_file_parser, only : log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_io_infra, only : MOM_read_data, MOM_read_vector, read_field_chksum -use MOM_io_infra, only : read_data=>MOM_read_data ! read_data will be removed soon. +use MOM_io_infra, only : read_field, read_vector +use MOM_io_infra, only : read_data => read_field ! Deprecated +use MOM_io_infra, only : read_field_chksum use MOM_io_infra, only : file_type, file_exists, get_file_info, get_file_fields use MOM_io_infra, only : open_file, open_ASCII_file, close_file, flush_file, file_is_open use MOM_io_infra, only : get_field_size, fieldtype, field_exists, get_field_atts @@ -64,6 +66,24 @@ module MOM_io !> These encoding constants are used to indicate the discretization position of a variable public :: CENTER, CORNER, NORTH_FACE, EAST_FACE +!> Read a field from file using the infrastructure I/O. +interface MOM_read_data + module procedure MOM_read_data_0d + module procedure MOM_read_data_0d_int + module procedure MOM_read_data_1d + module procedure MOM_read_data_1d_int + module procedure MOM_read_data_2d + module procedure MOM_read_data_2d_region + module procedure MOM_read_data_3d + module procedure MOM_read_data_4d +end interface MOM_read_data + +!> Read a vector from file using the infrastructure I/O. +interface MOM_read_vector + module procedure MOM_read_vector_2d + module procedure MOM_read_vector_3d +end interface MOM_read_vector + !> Write a registered field to an output file, potentially with rotation interface MOM_write_field module procedure MOM_write_field_4d @@ -1619,6 +1639,293 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & end subroutine query_vardesc +!> Read a scalar from file using infrastructure I/O. +subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + real, optional, intent(in) :: scale !< Rescale factor + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + call read_field(filename, fieldname, data, & + timelevel=timelevel, scale=scale, MOM_Domain=MOM_Domain, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) +end subroutine MOM_read_data_0d + + +!> Read a scalar integer from file using infrastructure I/O. +subroutine MOM_read_data_0d_int(filename, fieldname, data, timelevel) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + integer, intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + + call read_field(filename, fieldname, data, timelevel=timelevel) +end subroutine MOM_read_data_0d_int + + +!> Read a 1d array from file using infrastructure I/O. +subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Domain, & + global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:), intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + real, optional, intent(in) :: scale !< Rescale factor + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + call read_field(filename, fieldname, data, & + timelevel=timelevel, scale=scale, MOM_Domain=MOM_Domain, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) +end subroutine MOM_read_data_1d + + +!> Read a 1d integer array from file using infrastructure I/O. +subroutine MOM_read_data_1d_int(filename, fieldname, data, timelevel) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + integer, dimension(:), intent(inout) :: data !< Field value + integer, optional, intent(in) :: timelevel !< Time level to read in file + + call read_field(filename, fieldname, data, timelevel=timelevel) +end subroutine MOM_read_data_1d_int + + +!> Read a 2d array from file using infrastructure I/O. +subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:), intent(inout) :: data !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: position !< Grid positioning flag + real, optional, intent(in) :: scale !< Rescale factor + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: data_in(:,:) ! Field array on the input grid + + turns = MOM_domain%turns + if (turns == 0) then + call read_field(filename, fieldname, data, MOM_Domain, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + else + call allocate_rotated_array(data, [1,1], -turns, data_in) + call read_field(filename, fieldname, data_in, MOM_Domain%domain_in, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + call rotate_array(data_in, turns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_2d + + +!> Read a 2d region array from file using infrastructure I/O. +subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_domain, & + no_domain, scale, turns) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:), intent(inout) :: data !< Field value + integer, dimension(:), intent(in) :: start !< Starting index for each axis. + !! In 2d, start(3:4) must be 1. + integer, dimension(:), intent(in) :: nread !< Number of values to read along each axis. + !! In 2d, nread(3:4) must be 1. + type(MOM_domain_type), optional, intent(in) :: MOM_Domain !< Model domain decomposition + logical, optional, intent(in) :: no_domain !< If true, field does not use + !! domain decomposion. + real, optional, intent(in) :: scale !< Rescale factor + integer, optional, intent(in) :: turns !< Number of quarter turns from + !! input to model grid + + integer :: qturns ! Number of quarter turns + real, allocatable :: data_in(:,:) ! Field array on the input grid + + qturns = 0 + if (present(turns)) qturns = modulo(turns, 4) + + if (qturns == 0) then + call read_field(filename, fieldname, data, start, nread, & + MOM_Domain=MOM_Domain, no_domain=no_domain, scale=scale & + ) + else + call allocate_rotated_array(data, [1,1], -qturns, data_in) + call read_field(filename, fieldname, data_in, start, nread, & + MOM_Domain=MOM_Domain%domain_in, no_domain=no_domain, scale=scale & + ) + call rotate_array(data_in, qturns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_2d_region + + +!> Read a 3d array from file using infrastructure I/O. +subroutine MOM_read_data_3d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file, file_may_be_4d) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:,:), intent(inout) :: data !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: position !< Grid positioning flag + real, optional, intent(in) :: scale !< Rescale factor + logical, optional, intent(in) :: global_file !< If true, read from a single file + logical, optional, intent(in) :: file_may_be_4d !< If true, fields may be stored + !! as 4d arrays in the file. + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: data_in(:,:,:) ! Field array on the input grid + + turns = MOM_domain%turns + if (turns == 0) then + call read_field(filename, fieldname, data, MOM_Domain, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + else + call allocate_rotated_array(data, [1,1,1], -turns, data_in) + call read_field(filename, fieldname, data_in, MOM_Domain%domain_in, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file, file_may_be_4d=file_may_be_4d & + ) + call rotate_array(data_in, turns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_3d + + +!> Read a 4d array from file using infrastructure I/O. +subroutine MOM_read_data_4d(filename, fieldname, data, MOM_Domain, & + timelevel, position, scale, global_file) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: fieldname !< Field variable name + real, dimension(:,:,:,:), intent(inout) :: data !< Field value + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: position !< Grid positioning flag + real, optional, intent(in) :: scale !< Rescale factor + logical, optional, intent(in) :: global_file !< If true, read from a single file + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid + + turns = MOM_domain%turns + + if (turns == 0) then + call read_field(filename, fieldname, data, MOM_Domain, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file & + ) + else + ! Read field along the input grid and rotate to the model grid + call allocate_rotated_array(data, [1,1,1,1], -turns, data_in) + call read_field(filename, fieldname, data_in, MOM_Domain%domain_in, & + timelevel=timelevel, position=position, scale=scale, & + global_file=global_file & + ) + call rotate_array(data_in, turns, data) + deallocate(data_in) + endif +end subroutine MOM_read_data_4d + + +!> Read a 2d vector tuple from file using infrastructure I/O. +subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: u_fieldname !< Field variable name in u + character(len=*), intent(in) :: v_fieldname !< Field variable name in v + real, dimension(:,:), intent(inout) :: u_data !< Field value in u + real, dimension(:,:), intent(inout) :: v_data !< Field value in v + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: stagger !< Grid staggering flag + logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector + real, optional, intent(in) :: scale !< Rescale factor + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid + + turns = MOM_Domain%turns + if (turns == 0) then + call read_vector(filename, u_fieldname, v_fieldname, & + u_data, v_data, MOM_domain, timelevel=timelevel, stagger=stagger, & + scalar_pair=scalar_pair, scale=scale & + ) + else + call allocate_rotated_array(u_data, [1,1], -turns, u_data_in) + call allocate_rotated_array(v_data, [1,1], -turns, v_data_in) + call read_vector(filename, u_fieldname, v_fieldname, & + u_data_in, v_data_in, MOM_domain%domain_in, timelevel=timelevel, & + stagger=stagger, scalar_pair=scalar_pair, scale=scale & + ) + if (scalar_pair) then + call rotate_array_pair(u_data_in, v_data_in, turns, u_data, v_data) + else + call rotate_vector(u_data_in, v_data_in, turns, u_data, v_data) + endif + deallocate(v_data_in) + deallocate(u_data_in) + endif +end subroutine MOM_read_vector_2d + + +!> Read a 3d vector tuple from file using infrastructure I/O. +subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, & + timelevel, stagger, scalar_pair, scale) + character(len=*), intent(in) :: filename !< Input filename + character(len=*), intent(in) :: u_fieldname !< Field variable name in u + character(len=*), intent(in) :: v_fieldname !< Field variable name in v + real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u + real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v + type(MOM_domain_type), intent(in) :: MOM_Domain !< Model domain decomposition + integer, optional, intent(in) :: timelevel !< Time level to read in file + integer, optional, intent(in) :: stagger !< Grid staggering flag + logical, optional, intent(in) :: scalar_pair !< True if tuple is not a vector + real, optional, intent(in) :: scale !< Rescale factor + + integer :: turns ! Number of quarter-turns from input to model grid + real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid + + turns = MOM_Domain%turns + if (turns == 0) then + call read_vector(filename, u_fieldname, v_fieldname, & + u_data, v_data, MOM_domain, timelevel=timelevel, stagger=stagger, & + scalar_pair=scalar_pair, scale=scale & + ) + else + call allocate_rotated_array(u_data, [1,1,1], -turns, u_data_in) + call allocate_rotated_array(v_data, [1,1,1], -turns, v_data_in) + call read_vector(filename, u_fieldname, v_fieldname, & + u_data_in, v_data_in, MOM_domain%domain_in, timelevel=timelevel, & + stagger=stagger, scalar_pair=scalar_pair, scale=scale & + ) + if (scalar_pair) then + call rotate_array_pair(u_data_in, v_data_in, turns, u_data, v_data) + else + call rotate_vector(u_data_in, v_data_in, turns, u_data, v_data) + endif + deallocate(v_data_in) + deallocate(u_data_in) + endif +end subroutine MOM_read_vector_3d + + !> Write a 4d field to an output file, potentially with rotation subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 74db4e0f95..7896962bc1 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -22,10 +22,9 @@ module MOM_restart implicit none ; private public restart_init, restart_end, restore_state, register_restart_field -public save_restart, query_initialized, restart_init_end, vardesc +public save_restart, query_initialized, restart_registry_lock, restart_init_end, vardesc public restart_files_exist, determine_is_new_run, is_new_run -public register_restart_field_as_obsolete -public register_restart_pair +public register_restart_field_as_obsolete, register_restart_pair !> A type for making arrays of pointers to 4-d arrays type p4d @@ -87,6 +86,8 @@ module MOM_restart !! in which case the checksums will not match and cause crash. character(len=240) :: restartfile !< The name or name root for MOM restart files. integer :: turns !< Number of quarter turns from input to model domain + logical :: locked = .false. !< If true this registry has been locked and no further restart + !! fields can be added without explicitly unlocking the registry. !> An array of descriptions of the registered fields type(field_restart), pointer :: restart_field(:) => NULL() @@ -155,6 +156,8 @@ subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) + CS%novars = CS%novars+1 if (CS%novars > CS%max_fields) return ! This is an error that will be reported ! once the total number of fields is known. @@ -186,6 +189,8 @@ subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) + CS%novars = CS%novars+1 if (CS%novars > CS%max_fields) return ! This is an error that will be reported ! once the total number of fields is known. @@ -217,6 +222,8 @@ subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) + CS%novars = CS%novars+1 if (CS%novars > CS%max_fields) return ! This is an error that will be reported ! once the total number of fields is known. @@ -247,6 +254,8 @@ subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) + CS%novars = CS%novars+1 if (CS%novars > CS%max_fields) return ! This is an error that will be reported ! once the total number of fields is known. @@ -277,6 +286,8 @@ subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS) if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") + call lock_check(CS, var_desc) + CS%novars = CS%novars+1 if (CS%novars > CS%max_fields) return ! This is an error that will be reported ! once the total number of fields is known. @@ -307,6 +318,8 @@ subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, & logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + call lock_check(CS, a_desc) + if (modulo(CS%turns, 2) /= 0) then call register_restart_field(b_ptr, a_desc, mandatory, CS) call register_restart_field(a_ptr, b_desc, mandatory, CS) @@ -327,6 +340,8 @@ subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, & logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + call lock_check(CS, a_desc) + if (modulo(CS%turns, 2) /= 0) then call register_restart_field(b_ptr, a_desc, mandatory, CS) call register_restart_field(a_ptr, b_desc, mandatory, CS) @@ -347,6 +362,8 @@ subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, & logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), pointer :: CS !< MOM restart control structure + call lock_check(CS, a_desc) + if (modulo(CS%turns, 2) /= 0) then call register_restart_field(b_ptr, a_desc, mandatory, CS) call register_restart_field(a_ptr, b_desc, mandatory, CS) @@ -379,6 +396,9 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_4d: Module must be initialized before "//& "it is used to register "//trim(name)) + + call lock_check(CS, name=name) + vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & z_grid=z_grid, t_grid=t_grid) @@ -406,6 +426,9 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_3d: Module must be initialized before "//& "it is used to register "//trim(name)) + + call lock_check(CS, name=name) + vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & z_grid=z_grid, t_grid=t_grid) @@ -435,6 +458,9 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units "register_restart_field_2d: Module must be initialized before "//& "it is used to register "//trim(name)) zgrid = '1' ; if (present(z_grid)) zgrid = z_grid + + call lock_check(CS, name=name) + vd = var_desc(name, units=units, longname=longname, hor_grid=hor_grid, & z_grid=zgrid, t_grid=t_grid) @@ -463,6 +489,9 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units "register_restart_field_3d: Module must be initialized before "//& "it is used to register "//trim(name)) hgrid = '1' ; if (present(hor_grid)) hgrid = hor_grid + + call lock_check(CS, name=name) + vd = var_desc(name, units=units, longname=longname, hor_grid=hgrid, & z_grid=z_grid, t_grid=t_grid) @@ -483,9 +512,13 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent type(vardesc) :: vd + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart: " // & "register_restart_field_0d: Module must be initialized before "//& "it is used to register "//trim(name)) + + call lock_check(CS, name=name) + vd = var_desc(name, units=units, longname=longname, hor_grid='1', & z_grid='1', t_grid=t_grid) @@ -502,6 +535,7 @@ function query_initialized_name(name, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -533,6 +567,7 @@ function query_initialized_0d(f_ptr, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -557,6 +592,7 @@ function query_initialized_1d(f_ptr, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -582,6 +618,7 @@ function query_initialized_2d(f_ptr, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -607,6 +644,7 @@ function query_initialized_3d(f_ptr, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -632,6 +670,7 @@ function query_initialized_4d(f_ptr, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -658,6 +697,7 @@ function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -691,6 +731,7 @@ function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -724,6 +765,7 @@ function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -757,6 +799,7 @@ function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -790,6 +833,7 @@ function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) logical :: query_initialized integer :: m, n + if (.not.associated(CS)) call MOM_error(FATAL, "MOM_restart " // & "query_initialized: Module must be initialized before it is used.") if (CS%novars > CS%max_fields) call restart_error(CS) @@ -1092,7 +1136,6 @@ subroutine restore_state(filename, directory, day, G, CS) ! Check the remaining files for different times and issue a warning ! if they differ from the first time. - if (is_root_pe()) then do m = n+1,num_file call get_file_times(IO_handles(n), time_vals, ntime) if (ntime < 1) cycle @@ -1100,14 +1143,13 @@ subroutine restore_state(filename, directory, day, G, CS) t2 = time_vals(1) deallocate(time_vals) - if (t1 /= t2) then + if (t1 /= t2 .and. is_root_PE()) then write(mesg,'("WARNING: Restart file ",I2," has time ",F10.4,"whereas & &simulation is restarted at ",F10.4," (differing by ",F10.4,").")')& m,t1,t2,t1-t2 call MOM_error(WARNING, "MOM_restart: "//mesg) endif enddo - endif ! Read each variable from the first file in which it is found. do n=1,num_file @@ -1235,6 +1277,9 @@ subroutine restore_state(filename, directory, day, G, CS) endif enddo + ! Lock the restart registry so that no further variables can be registered. + CS%locked = .true. + end subroutine restore_state !> restart_files_exist determines whether any restart files exist. @@ -1482,8 +1527,8 @@ subroutine restart_init(param_file, CS, restart_root) logical :: rotate_index -! 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_restart" ! This module's name. logical :: all_default ! If true, all parameters are using their default values. @@ -1555,13 +1600,47 @@ subroutine restart_init(param_file, CS, restart_root) allocate(CS%var_ptr3d(CS%max_fields)) allocate(CS%var_ptr4d(CS%max_fields)) + CS%locked = .false. + end subroutine restart_init -!> Indicate that all variables have now been registered. +!> Issue an error message if the restart_registry is locked. +subroutine lock_check(CS, var_desc, name) + type(MOM_restart_CS), intent(in) :: CS !< A MOM_restart_CS object (intent in) + type(vardesc), optional, intent(in) :: var_desc !< A structure with metadata about this variable + character(len=*), optional, intent(in) :: name !< variable name to be used in the restart file + + character(len=256) :: var_name ! A variable name. + + if (CS%locked) then + if (present(var_desc)) then + call query_vardesc(var_desc, name=var_name) + call MOM_error(FATAL, "Attempted to register "//trim(var_name)//" but the restart registry is locked.") + elseif (present(name)) then + call MOM_error(FATAL, "Attempted to register "//trim(name)//" but the restart registry is locked.") + else + call MOM_error(FATAL, "Attempted to register a variable but the restart registry is locked.") + endif + endif + +end subroutine lock_check + +!> Lock the restart registry so that an error is issued if any further restart variables are registered. +subroutine restart_registry_lock(CS, unlocked) + type(MOM_restart_CS), intent(inout) :: CS !< A MOM_restart_CS object (intent inout) + logical, optional, intent(in) :: unlocked !< If present and true, unlock the registry + + CS%locked = .true. + if (present(unlocked)) CS%locked = .not.unlocked +end subroutine restart_registry_lock + +!> Indicate that all variables have now been registered and lock the registry. subroutine restart_init_end(CS) type(MOM_restart_CS), pointer :: CS !< A pointer to a MOM_restart_CS object if (associated(CS)) then + CS%locked = .true. + if (CS%novars == 0) call restart_end(CS) endif diff --git a/src/framework/MOM_safe_alloc.F90 b/src/framework/MOM_safe_alloc.F90 index 47dd8376a3..8960e8e358 100644 --- a/src/framework/MOM_safe_alloc.F90 +++ b/src/framework/MOM_safe_alloc.F90 @@ -38,11 +38,10 @@ subroutine safe_alloc_ptr_1d(ptr, i1, i2) integer, optional, intent(in) :: i2 !< The ending index of the array if (.not.associated(ptr)) then if (present(i2)) then - allocate(ptr(i1:i2)) + allocate(ptr(i1:i2), source=0.0) else - allocate(ptr(i1)) + allocate(ptr(i1), source=0.0) endif - ptr(:) = 0.0 endif end subroutine safe_alloc_ptr_1d @@ -52,8 +51,7 @@ subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj) integer, intent(in) :: ni !< The size of the 1st dimension of the array integer, intent(in) :: nj !< The size of the 2nd dimension of the array if (.not.associated(ptr)) then - allocate(ptr(ni,nj)) - ptr(:,:) = 0.0 + allocate(ptr(ni,nj), source=0.0) endif end subroutine safe_alloc_ptr_2d_2arg @@ -64,8 +62,7 @@ subroutine safe_alloc_ptr_3d_3arg(ptr, ni, nj, nk) integer, intent(in) :: nj !< The size of the 2nd dimension of the array integer, intent(in) :: nk !< The size of the 3rd dimension of the array if (.not.associated(ptr)) then - allocate(ptr(ni,nj,nk)) - ptr(:,:,:) = 0.0 + allocate(ptr(ni,nj,nk), source=0.0) endif end subroutine safe_alloc_ptr_3d_3arg @@ -77,8 +74,7 @@ subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je) integer, intent(in) :: js !< The start index to allocate for the 2nd dimension integer, intent(in) :: je !< The end index to allocate for the 2nd dimension if (.not.associated(ptr)) then - allocate(ptr(is:ie,js:je)) - ptr(:,:) = 0.0 + allocate(ptr(is:ie,js:je), source=0.0) endif end subroutine safe_alloc_ptr_2d @@ -91,8 +87,7 @@ subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk) integer, intent(in) :: je !< The end index to allocate for the 2nd dimension integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.associated(ptr)) then - allocate(ptr(is:ie,js:je,nk)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,nk), source=0.0) endif end subroutine safe_alloc_ptr_3d @@ -106,8 +101,7 @@ subroutine safe_alloc_ptr_3d_6arg(ptr, is, ie, js, je, ks, ke) integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension if (.not.associated(ptr)) then - allocate(ptr(is:ie,js:je,ks:ke)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,ks:ke), source=0.0) endif end subroutine safe_alloc_ptr_3d_6arg @@ -120,8 +114,7 @@ subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) integer, intent(in) :: js !< The start index to allocate for the 2nd dimension integer, intent(in) :: je !< The end index to allocate for the 2nd dimension if (.not.allocated(ptr)) then - allocate(ptr(is:ie,js:je)) - ptr(:,:) = 0.0 + allocate(ptr(is:ie,js:je), source=0.0) endif end subroutine safe_alloc_allocatable_2d @@ -135,8 +128,7 @@ subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) integer, intent(in) :: je !< The end index to allocate for the 2nd dimension integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.allocated(ptr)) then - allocate(ptr(is:ie,js:je,nk)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,nk), source=0.0) endif end subroutine safe_alloc_allocatable_3d @@ -150,8 +142,7 @@ subroutine safe_alloc_allocatable_3d_6arg(ptr, is, ie, js, je, ks, ke) integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension if (.not.allocated(ptr)) then - allocate(ptr(is:ie,js:je,ks:ke)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,ks:ke), source=0.0) endif end subroutine safe_alloc_allocatable_3d_6arg diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 7dc0124930..cfe75ba380 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1309,7 +1309,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, ! Set up the bottom depth, G%D either analytically or from file call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file) call rescale_dyn_horgrid_bathymetry(dG, CS%US%Z_to_m) - call copy_dyngrid_to_MOM_grid(dG,CS%Grid,CS%US) + call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) call destroy_dyn_horgrid(dG) ! endif G => CS%Grid ; CS%Grid_in => CS%Grid @@ -1524,7 +1524,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, inputdir = slasher(inputdir) TideAmp_file = trim(inputdir) // trim(TideAmp_file) if (CS%rotate_index) then - allocate(tmp2d(CS%Grid_in%isd:CS%Grid_in%ied,CS%Grid_in%jsd:CS%Grid_in%jed)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(CS%Grid_in%isd:CS%Grid_in%ied,CS%Grid_in%jsd:CS%Grid_in%jed), source=0.0) call MOM_read_data(TideAmp_file, 'tideamp', tmp2d, CS%Grid_in%domain, timelevel=1, scale=US%m_s_to_L_T) call rotate_array(tmp2d, CS%turns, CS%utide) deallocate(tmp2d) @@ -1994,9 +1994,9 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) if (CS%rotate_index) then - allocate(tmp2d(CS%Grid_in%isc:CS%Grid_in%iec,CS%Grid_in%jsc:CS%Grid_in%jec)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(CS%Grid_in%isc:CS%Grid_in%iec,CS%Grid_in%jsc:CS%Grid_in%jec), source=0.0) else - allocate(tmp2d(is:ie,js:je)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(is:ie,js:je), source=0.0) endif call time_interp_external(CS%id_read_mass, Time, tmp2d) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 1f8d45e88d..7c7705ef35 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -89,9 +89,10 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: h_bdry_val => NULL() !< The ice thickness at inflowing boundaries [m]. real, pointer, dimension(:,:) :: t_bdry_val => NULL() !< The ice temperature at inflowing boundaries [degC]. - real, pointer, dimension(:,:) :: bed_elev => NULL() !< The bed elevation used for ice dynamics [Z ~> m]. - !! the same as bathyT, when below sea-level. - !!Sign convention: positive below sea-level, negative above. + real, pointer, dimension(:,:) :: bed_elev => NULL() !< The bed elevation used for ice dynamics [Z ~> m], + !! relative to mean sea-level. This is + !! the same as G%bathyT+Z_ref, when below sea-level. + !! Sign convention: positive below sea-level, negative above. real, pointer, dimension(:,:) :: basal_traction => NULL() !< The area integrated nonlinear part of "linearized" !! basal stress [R Z L2 T-1 ~> kg s-1]. @@ -255,46 +256,46 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) endif if (active_shelf_dynamics) then - allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%u_shelf(:,:) = 0.0 - allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%v_shelf(:,:) = 0.0 - allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 - allocate( CS%ice_visc(isd:ied,jsd:jed) ) ; CS%ice_visc(:,:) = 0.0 - allocate( CS%AGlen_visc(isd:ied,jsd:jed) ) ; CS%AGlen_visc(:,:) = 2.261e-25 - allocate( CS%basal_traction(isd:ied,jsd:jed) ) ; CS%basal_traction(:,:) = 0.0 - allocate( CS%C_basal_friction(isd:ied,jsd:jed) ) ; CS%C_basal_friction(:,:) = 5.0e10 - allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 - allocate( CS%ground_frac(isd:ied,jsd:jed) ) ; CS%ground_frac(:,:) = 0.0 - allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%taudx_shelf(:,:) = 0.0 - allocate( CS%taudy_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%taudy_shelf(:,:) = 0.0 - allocate( CS%bed_elev(isd:ied,jsd:jed) ) ; CS%bed_elev(:,:)=G%bathyT(:,:)!CS%bed_elev(:,:) = 0.0 - allocate( CS%u_bdry_val(IsdB:IedB,JsdB:JedB) ) ; CS%u_bdry_val(:,:) = 0.0 - allocate( CS%v_bdry_val(IsdB:IedB,JsdB:JedB) ) ; CS%v_bdry_val(:,:) = 0.0 - allocate( CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB) ) ; CS%u_face_mask_bdry(:,:) = -2.0 - allocate( CS%v_face_mask_bdry(IsdB:iedB,JsdB:JedB) ) ; CS%v_face_mask_bdry(:,:) = -2.0 - allocate( CS%h_bdry_val(isd:ied,jsd:jed) ) ; CS%h_bdry_val(:,:) = 0.0 + allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0 ) ! [degC] + allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Units?] + allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Units?] + allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%taudy_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%bed_elev(isd:ied,jsd:jed) ) ; CS%bed_elev(:,:) = G%bathyT(:,:) + G%Z_ref + allocate( CS%u_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%v_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB), source=-2.0 ) + allocate( CS%v_face_mask_bdry(IsdB:iedB,JsdB:JedB), source=-2.0 ) + allocate( CS%h_bdry_val(isd:ied,jsd:jed), source=0.0 ) ! additional restarts for ice shelf state call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') call register_restart_field(CS%v_shelf, "v_shelf", .false., restart_CS, & "ice sheet/shelf v-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%u_bdry_val, "u_bdry", .false., restart_CS, & + call register_restart_field(CS%u_bdry_val, "u_bdry_val", .false., restart_CS, & "ice sheet/shelf boundary u-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%v_bdry_val, "v_bdry", .false., restart_CS, & + call register_restart_field(CS%v_bdry_val, "v_bdry_val", .false., restart_CS, & "ice sheet/shelf boundary v-velocity", "m s-1", hor_grid='Bu') - call register_restart_field(CS%u_face_mask_bdry, "u_bdry_mask", .false., restart_CS, & + call register_restart_field(CS%u_face_mask_bdry, "u_face_mask_bdry", .false., restart_CS, & "ice sheet/shelf boundary u-mask", "nondim", hor_grid='Bu') - call register_restart_field(CS%v_face_mask_bdry, "v_bdry_mask", .false., restart_CS, & + call register_restart_field(CS%v_face_mask_bdry, "v_face_mask_bdry", .false., restart_CS, & "ice sheet/shelf boundary v-mask", "nondim", hor_grid='Bu') call register_restart_field(CS%OD_av, "OD_av", .true., restart_CS, & "Average open ocean depth in a cell","m") call register_restart_field(CS%ground_frac, "ground_frac", .true., restart_CS, & "fractional degree of grounding", "nondim") - call register_restart_field(CS%C_basal_friction, "tau_b_beta", .true., restart_CS, & + call register_restart_field(CS%C_basal_friction, "C_basal_friction", .true., restart_CS, & "basal sliding coefficients", "Pa (m s-1)^n_sliding") - call register_restart_field(CS%AGlen_visc, "A_Glen", .true., restart_CS, & + call register_restart_field(CS%AGlen_visc, "AGlen_visc", .true., restart_CS, & "ice-stiffness parameter", "Pa-3 s-1") - call register_restart_field(CS%h_bdry_val, "h_bdry", .false., restart_CS, & + call register_restart_field(CS%h_bdry_val, "h_bdry_val", .false., restart_CS, & "ice thickness at the boundary","m") endif @@ -436,22 +437,22 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! previously allocated for registration for restarts. if (active_shelf_dynamics) then - allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 - allocate( CS%thickness_bdry_val(isd:ied,jsd:jed) ) ; CS%thickness_bdry_val(:,:) = 0.0 - allocate( CS%u_face_mask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_face_mask(:,:) = 0.0 - allocate( CS%v_face_mask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 - allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_bdry_val(:,:) = 0.0 - allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_bdry_val(:,:) = 0.0 - allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 - allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 - allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=-15.0) ! [degC] + allocate( CS%thickness_bdry_val(isd:ied,jsd:jed), source=0.0) + allocate( CS%u_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) + allocate( CS%v_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) + allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed), source=0.0) + allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq), source=0.0) + allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq), source=-1.0) + allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq), source=-1.0) + allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq), source=-1.0) CS%OD_rt_counter = 0 - allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 - allocate( CS%ground_frac_rt(isd:ied,jsd:jed) ) ; CS%ground_frac_rt(:,:) = 0.0 + allocate( CS%OD_rt(isd:ied,jsd:jed), source=0.0) + allocate( CS%ground_frac_rt(isd:ied,jsd:jed), source=0.0) if (CS%calve_to_mask) then - allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 + allocate( CS%calve_mask(isd:ied,jsd:jed), source=0.0) endif CS%elapsed_velocity_time = 0.0 @@ -503,6 +504,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_var(CS%ground_frac,G%domain) call pass_var(CS%ice_visc,G%domain) call pass_var(CS%basal_traction, G%domain) + call pass_var(CS%AGlen_visc, G%domain) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) endif @@ -533,30 +535,31 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ endif ! initialize basal friction coefficients - call initialize_ice_C_basal_friction(CS%C_basal_friction, G, US, param_file) - call pass_var(CS%C_basal_friction, G%domain) + if (new_sim) then + call initialize_ice_C_basal_friction(CS%C_basal_friction, G, US, param_file) + call pass_var(CS%C_basal_friction, G%domain) - ! initialize ice-stiffness AGlen - call initialize_ice_AGlen(CS%AGlen_visc, G, US, param_file) - call pass_var(CS%AGlen_visc, G%domain) + ! initialize ice-stiffness AGlen + call initialize_ice_AGlen(CS%AGlen_visc, G, US, param_file) + call pass_var(CS%AGlen_visc, G%domain) - !initialize boundary conditions - call initialize_ice_shelf_boundary_from_file(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & + !initialize boundary conditions + call initialize_ice_shelf_boundary_from_file(CS%u_face_mask_bdry, CS%v_face_mask_bdry, & CS%u_bdry_val, CS%v_bdry_val, CS%umask, CS%vmask, CS%h_bdry_val, & CS%thickness_bdry_val, ISS%hmask, ISS%h_shelf, G, US, param_file ) - call pass_var(ISS%hmask, G%domain) - call pass_var(CS%h_bdry_val, G%domain) - call pass_var(CS%thickness_bdry_val, G%domain) - call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) - call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) - - !initialize ice flow velocities from file - call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & + call pass_var(ISS%hmask, G%domain) + call pass_var(CS%h_bdry_val, G%domain) + call pass_var(CS%thickness_bdry_val, G%domain) + call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) + call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) + + !initialize ice flow velocities from file + call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & G, US, param_file) - call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) - call pass_var(CS%bed_elev, G%domain,CENTER) - call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) - + call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) + call pass_var(CS%bed_elev, G%domain,CENTER) + call update_velocity_masks(CS, G, ISS%hmask, CS%umask, CS%vmask, CS%u_face_mask, CS%v_face_mask) + endif ! Register diagnostics. CS%id_u_shelf = register_diag_field('ice_shelf_model','u_shelf',CS%diag%axesB1, Time, & 'x-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) @@ -564,16 +567,15 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) ! I think that the conversion factors for the next two diagnostics are wrong. - RWH CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesB1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) + 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesB1, Time, & - 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%L_T_to_m_s) + 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesB1, Time, & 'mask for u-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesB1, Time, & 'mask for v-nodes', 'none') CS%id_ground_frac = register_diag_field('ice_shelf_model','ice_ground_frac',CS%diag%axesT1, Time, & 'fraction of cell that is grounded', 'none') -! CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & @@ -582,12 +584,10 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'taub', 'Pa yr m-1', conversion=1e-6*US%Z_to_m) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) - if (new_sim) then - call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) - endif endif + call MOM_mesg("MOM_ice_shelf.F90, initialize_ice_shelf: initialize ice velocity.") + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) end subroutine initialize_ice_shelf_dyn @@ -611,7 +611,7 @@ subroutine initialize_diagnostic_fields(CS, ISS, G, US, Time) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi_rhow * ISS%h_shelf(i,j) + OD = CS%bed_elev(i,j) - rhoi_rhow * ISS%h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -683,46 +683,46 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled coupled_GL = .false. if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding ! - call ice_shelf_advect(CS, ISS, G, time_step, Time) - CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step - if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. - - if (coupled_GL) then - call update_OD_ffrac(CS, G, US, ocean_mass, update_ice_vel) - elseif (update_ice_vel) then - call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) - endif + call ice_shelf_advect(CS, ISS, G, time_step, Time) + CS%elapsed_velocity_time = CS%elapsed_velocity_time + time_step + if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) update_ice_vel = .true. + if (coupled_GL) then + call update_OD_ffrac(CS, G, US, ocean_mass, update_ice_vel) + elseif (update_ice_vel) then + call update_OD_ffrac_uncoupled(CS, G, ISS%h_shelf(:,:)) + endif - if (update_ice_vel) then - call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) - endif + + if (update_ice_vel) then + call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) + endif ! call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) - if (update_ice_vel) then - call enable_averages(CS%elapsed_velocity_time, Time, CS%diag) - if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) - if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) - if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) + if (update_ice_vel) then + call enable_averages(CS%elapsed_velocity_time, Time, CS%diag) + if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) + if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) + if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) ! if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) - if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) - if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) + if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) + if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) + if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) + if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) + if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) !! - if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) - if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) - if (CS%id_ufb_mask > 0) call post_data(CS%id_ufb_mask,CS%u_face_mask_bdry,CS%diag) - if (CS%id_vfb_mask > 0) call post_data(CS%id_vfb_mask,CS%v_face_mask_bdry,CS%diag) + if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) + if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) + if (CS%id_ufb_mask > 0) call post_data(CS%id_ufb_mask,CS%u_face_mask_bdry,CS%diag) + if (CS%id_vfb_mask > 0) call post_data(CS%id_vfb_mask,CS%v_face_mask_bdry,CS%diag) ! if (CS%id_t_mask > 0) call post_data(CS%id_t_mask,CS%tmask,CS%diag) - call disable_averaging(CS%diag) + call disable_averaging(CS%diag) - CS%elapsed_velocity_time = 0.0 - endif + CS%elapsed_velocity_time = 0.0 + endif end subroutine update_ice_shelf @@ -816,7 +816,7 @@ end subroutine ice_shelf_advect !>This subroutine computes u- and v-velocities of the ice shelf iterating on non-linear ice viscosity !subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, iters, time) - subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, iters, Time) + subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, iters, Time) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -867,15 +867,15 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite ! need to make these conditional on GL interpolation float_cond(:,:) = 0.0 ; H_node(:,:) = 0.0 CS%ground_frac(:,:) = 0.0 - allocate(Phisub(nsub,nsub,2,2,2,2)) ; Phisub(:,:,:,:,:,:) = 0.0 + allocate(Phisub(nsub,nsub,2,2,2,2), source=0.0) - do j=G%jsc,G%jec - do i=G%isc,G%iec - if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) > 0) then - float_cond(i,j) = 1.0 - CS%ground_frac(i,j) = 1.0 - endif - enddo + do j=G%jsc,G%jec + do i=G%isc,G%iec + if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) > 0) then + float_cond(i,j) = 1.0 + CS%ground_frac(i,j) = 1.0 + endif + enddo enddo call calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, CS%OD_av) @@ -896,7 +896,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite do l=0,1 ; do k=0,1 if ((ISS%hmask(i,j) == 1) .and. & - (rhoi_rhow * H_node(i-1+k,j-1+l) - G%bathyT(i,j) <= 0)) then + (rhoi_rhow * H_node(i-1+k,j-1+l) - CS%bed_elev(i,j) <= 0)) then nodefloat = nodefloat + 1 endif enddo ; enddo @@ -913,7 +913,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite endif ! must prepare Phi - allocate(Phi(1:8,1:4,isd:ied,jsd:jed)) ; Phi(:,:,:,:) = 0.0 + allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0) do j=jsd,jed ; do i=isd,ied call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) @@ -936,7 +936,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite Au(:,:) = 0.0 ; Av(:,:) = 0.0 call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) call pass_vector(Au,Av,G%domain,TO_ALL,BGRID_NE) @@ -992,7 +992,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, ISS%hmask, H_node, & - CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, G%isc-1, G%iec+1, G%jsc-1, G%jec+1, rhoi_rhow) err_max = 0 @@ -1043,16 +1043,15 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf,taudx,taudy, ite call MOM_mesg(mesg, 5) if (err_max <= CS%nonlinear_tolerance * err_init) then - write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init - call MOM_mesg(mesg) - write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" -! call MOM_mesg(mesg, 5) - call MOM_mesg(mesg) exit endif enddo + write(mesg,*) "ice_shelf_solve_outer: nonlinear fractional residual = ", err_max/err_init + call MOM_mesg(mesg) + write(mesg,*) "ice_shelf_solve_outer: exiting nonlinear solve after ",iter," iterations" + call MOM_mesg(mesg) deallocate(Phi) deallocate(Phisub) @@ -1086,6 +1085,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H !! iterations have converged to the specified tolerance integer, intent(out) :: iters !< The number of iterations used in the solver. type(time_type), intent(in) :: Time !< The current model time + character(len=160) :: mesg ! The text of an error message real, dimension(8,4,SZDI_(G),SZDJ_(G)), & intent(in) :: Phi !< The gradients of bilinear basis elements at Gaussian !! quadrature points surrounding the cell vertices [L-1 ~> m-1]. @@ -1162,7 +1162,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H call pass_vector(DIAGu, DIAGv, G%domain, TO_ALL, BGRID_NE) call CG_action(Au, Av, u_shlf, v_shlf, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + H_node, CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, isc-1, iec+1, jsc-1, jec+1, rhoi_rhow) call pass_vector(Au, Av, G%domain, TO_ALL, BGRID_NE) @@ -1216,7 +1216,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H Au(:,:) = 0 ; Av(:,:) = 0 call CG_action(Au, Av, Du, Dv, Phi, Phisub, CS%umask, CS%vmask, hmask, & - H_node, CS%ice_visc, float_cond, G%bathyT, CS%basal_traction, & + H_node, CS%ice_visc, float_cond, CS%bed_elev, CS%basal_traction, & G, US, is, ie, js, je, rhoi_rhow) ! Au, Av valid region moves in by 1 @@ -1820,21 +1820,16 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! prelim - go through and calculate S ! or is this faster? - !BASE(:,:) = -G%bathyT(:,:) + OD(:,:) BASE(:,:) = -CS%bed_elev(:,:) + OD(:,:) S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded do j=jsc-G%domain%njhalo,jec+G%domain%njhalo - do i=isc-G%domain%nihalo,iec+G%domain%nihalo - -! if (ISS%h_shelf(i,j) < rhow/rho * G%bathyT(i,j)) then - if (rhoi_rhow * ISS%h_shelf(i,j) - G%bathyT(i,j) <= 0) then - S(i,j)=(1 - rhoi_rhow)*ISS%h_shelf(i,j) - endif - - - enddo + do i=isc-G%domain%nihalo,iec+G%domain%nihalo + if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then + S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) + endif + enddo enddo do j=jsc-1,jec+1 do i=isc-1,iec+1 @@ -1935,7 +1930,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif if (CS%ground_frac(i,j) == 1) then -! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * G%bathyT(i,j)**2) +! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2) neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 @@ -2086,8 +2081,9 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas intent(in) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. - real, dimension(SZDI_(G),SZDJ_(G)), & + intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points + !! relative to sea-level [Z ~> m]. + real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: basal_trac !< A field related to the nonlinear part of the !! "linearized" basal stress [R Z T-1 ~> kg m-2 s-1]. @@ -2206,7 +2202,8 @@ subroutine CG_action_subgrid_basal(Phisub, H, U, V, bathyT, dens_ratio, Ucontr, real, dimension(2,2), intent(in) :: H !< The ice shelf thickness at nodal (corner) points [Z ~> m]. real, dimension(2,2), intent(in) :: U !< The zonal ice shelf velocity at vertices [L T-1 ~> m s-1] real, dimension(2,2), intent(in) :: V !< The meridional ice shelf velocity at vertices [L T-1 ~> m s-1] - real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points [Z ~> m]. + real, intent(in) :: bathyT !< The depth of ocean bathymetry at tracer points + !! relative to sea-level [Z ~> m]. real, intent(in) :: dens_ratio !< The density of ice divided by the density !! of seawater [nondim] real, dimension(2,2), intent(out) :: Ucontr !< The areal average of u-velocities where the ice shelf @@ -2338,7 +2335,7 @@ subroutine matrix_diagonal(CS, G, US, float_cond, H_node, ice_visc, basal_trac, if (float_cond(i,j) == 1) then Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_diagonal_subgrid_basal(Phisub, Hcell, G%bathyT(i,j), dens_ratio, sub_ground) + call CG_diagonal_subgrid_basal(Phisub, Hcell, CS%bed_elev(i,j), dens_ratio, sub_ground) do iphi=1,2 ; do jphi=1,2 ; Itgt = I-2+iphi ; Jtgt = J-2+jphi if (CS%umask(Itgt,Jtgt) == 1) then u_diagonal(Itgt,Jtgt) = u_diagonal(Itgt,Jtgt) + sub_ground(iphi,jphi) * basal_trac(i,j) @@ -2512,7 +2509,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, if (float_cond(i,j) == 1) then Ucell(:,:) = CS%u_bdry_val(i-1:i,j-1:j) ; Vcell(:,:) = CS%v_bdry_val(i-1:i,j-1:j) Hcell(:,:) = H_node(i-1:i,j-1:j) - call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, G%bathyT(i,j), & + call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, CS%bed_elev(i,j), & dens_ratio, Usubcontr, Vsubcontr) if (CS%umask(I-1,J-1)==1) u_bdry_contr(I-1,J-1) = u_bdry_contr(I-1,J-1) + Usubcontr(1,1) * basal_trac(i,j) @@ -2586,7 +2583,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) -! CS%ice_visc(i,j) =1e14*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging +! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) endif @@ -2693,7 +2690,7 @@ subroutine update_OD_ffrac_uncoupled(CS, G, h_shelf) do j=jsd,jed do i=isd,ied - OD = G%bathyT(i,j) - rhoi_rhow * h_shelf(i,j) + OD = CS%bed_elev(i,j) - rhoi_rhow * h_shelf(i,j) if (OD >= 0) then ! ice thickness does not take up whole ocean column -> floating CS%OD_av(i,j) = OD @@ -2938,7 +2935,7 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face do j=js,G%jed do i=is,G%ied - if (hmask(i,j) == 1) then + if ((hmask(i,j) == 1) .OR. (hmask(i,j) == 3)) then umask(I,j) = 1. vmask(I,j) = 1. @@ -2947,10 +2944,10 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%u_face_mask_bdry(I-1+k,j))) case (3) - ! vmask(I-1+k,J-1)=0. + vmask(I-1+k,J-1)=3. u_face_mask(I-1+k,j)=3. umask(I-1+k,J)=3. - !vmask(I-1+k,J)=0. + vmask(I-1+k,J)=3. vmask(I-1+k,J)=3. case (2) u_face_mask(I-1+k,j)=2. @@ -2973,9 +2970,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face select case (int(CS%v_face_mask_bdry(i,J-1+k))) case (3) vmask(I-1,J-1+k)=3. - umask(I-1,J-1+k)=0. + umask(I-1,J-1+k)=3. vmask(I,J-1+k)=3. - umask(I,J-1+k)=0. + umask(I,J-1+k)=3. v_face_mask(i,J-1+k)=3. case (2) v_face_mask(i,J-1+k)=2. diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f3a5f210fc..469cba39ce 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -7,7 +7,7 @@ module MOM_ice_shelf_initialize use MOM_array_transform, only : rotate_array use MOM_hor_index, only : hor_index_type use MOM_file_parser, only : get_param, read_param, log_param, param_file_type -use MOM_io, only: MOM_read_data, file_exists, slasher, CORNER +use MOM_io, only: MOM_read_data, file_exists, field_exists, slasher, CORNER use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_unit_scaling, only : unit_scale_type use user_shelf_init, only: USER_init_ice_thickness @@ -61,9 +61,9 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P if (PRESENT(rotate_index)) rotate=rotate_index if (rotate) then - allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp1_2d(:,:)=0.0 - allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp2_2d(:,:)=0.0 - allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp3_2d(:,:)=0.0 + allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) + allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) + allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) select case ( trim(config) ) case ("CHANNEL") ; call initialize_ice_thickness_channel (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) case ("FILE") ; call initialize_ice_thickness_from_file (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) @@ -101,9 +101,10 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U ! This subroutine reads ice thickness and area from a file and puts it into ! h_shelf [Z ~> m] and area_shelf_h [L2 ~> m2] (and dimensionless) and updates hmask character(len=200) :: filename,thickness_file,inputdir ! Strings for file/path - character(len=200) :: thickness_varname, area_varname ! Variable name in file + character(len=200) :: thickness_varname, area_varname, hmask_varname ! Variable name in file character(len=40) :: mdl = "initialize_ice_thickness_from_file" ! This subroutine's name. integer :: i, j, isc, jsc, iec, jec + logical :: hmask_set real :: len_sidestress, mask, udh call MOM_mesg("Initialize_ice_thickness_from_file: reading thickness") @@ -125,45 +126,61 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U call get_param(PF, mdl, "ICE_AREA_VARNAME", area_varname, & "The name of the area variable in ICE_THICKNESS_FILE.", & default="area_shelf_h") - + hmask_varname="h_mask" if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) call MOM_read_data(filename, trim(thickness_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(area_varname), area_shelf_h, G%Domain, scale=US%m_to_L**2) - + if (field_exists(filename, trim(hmask_varname), MOM_domain=G%Domain)) then + call MOM_read_data(filename, trim(hmask_varname), hmask, G%Domain) + hmask_set = .true. + else + call MOM_error(WARNING, "Ice shelf thickness initialized without setting the shelf mask "//& + "from variable "//trim(hmask_varname)//", which does not exist in "//trim(filename)) + hmask_set = .false. + endif isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec - do j=jsc,jec - do i=isc,iec + if (.not.hmask_set) then + ! Set hmask based on the values in h_shelf. + do j=jsc,jec ; do i=isc,iec + hmask(i,j) = 0.0 + if (h_shelf(i,j) > 0.0) hmask(i,j) = 1.0 + enddo ; enddo + endif + + if (len_sidestress > 0.) then + do j=jsc,jec + do i=isc,iec ! taper ice shelf in area where there is no sidestress - ! but do not interfere with hmask - if ((G%geoLonCv(i,j) > len_sidestress).and. & - (len_sidestress > 0.)) then - udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) - if (udh <= 25.0) then - h_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - else - h_shelf(i,j) = udh + if (G%geoLonCv(i,j) > len_sidestress) then + udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) + if (udh <= 25.0) then + h_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + else + h_shelf(i,j) = udh + endif endif - endif ! update thickness mask - if (area_shelf_h (i,j) >= 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 - hmask(i,j) = 2. - else - call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") - endif + if (area_shelf_h(i,j) >= G%areaT(i,j)) then + hmask(i,j) = 1. + area_shelf_h(i,j)=G%areaT(i,j) + 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 + hmask(i,j) = 2. + else + call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") + endif + enddo enddo - enddo - + endif end subroutine initialize_ice_thickness_from_file !> Initialize ice shelf thickness for a channel configuration diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index a3784b5a34..ed3b419c9a 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -67,16 +67,16 @@ subroutine ice_shelf_state_init(ISS, G) endif allocate(ISS) - allocate(ISS%mass_shelf(isd:ied,jsd:jed) ) ; ISS%mass_shelf(:,:) = 0.0 - allocate(ISS%area_shelf_h(isd:ied,jsd:jed) ) ; ISS%area_shelf_h(:,:) = 0.0 - allocate(ISS%h_shelf(isd:ied,jsd:jed) ) ; ISS%h_shelf(:,:) = 0.0 - allocate(ISS%hmask(isd:ied,jsd:jed) ) ; ISS%hmask(:,:) = -2.0 - - allocate(ISS%tflux_ocn(isd:ied,jsd:jed) ) ; ISS%tflux_ocn(:,:) = 0.0 - allocate(ISS%water_flux(isd:ied,jsd:jed) ) ; ISS%water_flux(:,:) = 0.0 - allocate(ISS%salt_flux(isd:ied,jsd:jed) ) ; ISS%salt_flux(:,:) = 0.0 - allocate(ISS%tflux_shelf(isd:ied,jsd:jed) ) ; ISS%tflux_shelf(:,:) = 0.0 - allocate(ISS%tfreeze(isd:ied,jsd:jed) ) ; ISS%tfreeze(:,:) = 0.0 + allocate(ISS%mass_shelf(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%area_shelf_h(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%h_shelf(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%hmask(isd:ied,jsd:jed), source=-2.0 ) + + allocate(ISS%tflux_ocn(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%water_flux(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%salt_flux(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%tflux_shelf(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%tfreeze(isd:ied,jsd:jed), source=0.0 ) end subroutine ice_shelf_state_init diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index fbee77d130..81e7b66d7a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -9,7 +9,7 @@ module MOM_grid_initialize use MOM_domains, only : To_North, To_South, To_East, To_West use MOM_domains, only : MOM_domain_type, clone_MOM_domain, deallocate_MOM_domain use MOM_dyn_horgrid, only : dyn_horgrid_type, set_derived_dyn_horgrid -use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_io, only : MOM_read_data, slasher, file_exists, stdout @@ -333,7 +333,8 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) start(2) = 2 ; nread(1) = ni+1 ; nread(2) = 2 allocate( tmpGlbl(ni+1,2) ) if (is_root_PE()) & - call MOM_read_data(filename, "x", tmpGlbl, start, nread, no_domain=.TRUE.) + call MOM_read_data(filename, "x", tmpGlbl, start, nread, & + no_domain=.TRUE., turns=G%HI%turns) call broadcast(tmpGlbl, 2*(ni+1), root_PE()) ! I don't know why the second axis is 1 or 2 here. -RWH @@ -351,7 +352,8 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) start(:) = 1 ; nread(:) = 1 start(1) = int(ni/4)+1 ; nread(2) = nj+1 if (is_root_PE()) & - call MOM_read_data(filename, "y", tmpGlbl, start, nread, no_domain=.TRUE.) + call MOM_read_data(filename, "y", tmpGlbl, start, nread, & + no_domain=.TRUE., turns=G%HI%turns) call broadcast(tmpGlbl, nj+1, root_PE()) do j=G%jsg,G%jeg @@ -1187,7 +1189,7 @@ end function Adcroft_reciprocal !> Initializes the grid masks and any metrics that come with masks already applied. !! !! Initialize_masks sets mask2dT, mask2dCu, mask2dCv, and mask2dBu to mask out -!! flow over any points which are shallower than Dmin and permit an +!! flow over any points which are shallower than Dmask and permit an !! appropriate treatment of the boundary conditions. mask2dCu and mask2dCv !! are 0.0 at any points adjacent to a land point. mask2dBu is 0.0 at !! any land or boundary point. For points in the interior, mask2dCu, @@ -1199,7 +1201,7 @@ subroutine initialize_masks(G, PF, US) ! 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 :: Dmask ! 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]. character(len=40) :: mdl = "MOM_grid_init initialize_masks" @@ -1217,23 +1219,18 @@ subroutine initialize_masks(G, PF, US) units="m", default=0.0, scale=m_to_Z_scale) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& - "fluxes are zeroed out. MASKING_DEPTH needs to be smaller than MINIMUM_DEPTH", & + "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& + "default value.", & units="m", default=-9999.0, scale=m_to_Z_scale) - if (mask_depth > min_depth) then - mask_depth = -9999.0*m_to_Z_scale - call MOM_error(WARNING, "MOM_grid_init: initialize_masks "//& - 'MASKING_DEPTH is larger than MINIMUM_DEPTH and therefore ignored.') - endif - - Dmin = min_depth - if (mask_depth /= -9999.*m_to_Z_scale) Dmin = mask_depth + Dmask = mask_depth + if (mask_depth == -9999.*m_to_Z_scale) Dmask = min_depth G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 ! Construct the h-point or T-point mask do j=G%jsd,G%jed ; do i=G%isd,G%ied - if (G%bathyT(i,j) <= Dmin) then + if (G%bathyT(i,j) <= Dmask) then G%mask2dT(i,j) = 0.0 else G%mask2dT(i,j) = 1.0 @@ -1241,7 +1238,7 @@ subroutine initialize_masks(G, PF, US) enddo ; enddo do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 - if ((G%bathyT(i,j) <= Dmin) .or. (G%bathyT(i+1,j) <= Dmin)) then + if ((G%bathyT(i,j) <= Dmask) .or. (G%bathyT(i+1,j) <= Dmask)) then G%mask2dCu(I,j) = 0.0 else G%mask2dCu(I,j) = 1.0 @@ -1249,7 +1246,7 @@ subroutine initialize_masks(G, PF, US) enddo ; enddo do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied - if ((G%bathyT(i,j) <= Dmin) .or. (G%bathyT(i,j+1) <= Dmin)) then + if ((G%bathyT(i,j) <= Dmask) .or. (G%bathyT(i,j+1) <= Dmask)) then G%mask2dCv(i,J) = 0.0 else G%mask2dCv(i,J) = 1.0 @@ -1257,8 +1254,8 @@ subroutine initialize_masks(G, PF, US) enddo ; enddo do J=G%jsd,G%jed-1 ; do I=G%isd,G%ied-1 - if ((G%bathyT(i+1,j) <= Dmin) .or. (G%bathyT(i+1,j+1) <= Dmin) .or. & - (G%bathyT(i,j) <= Dmin) .or. (G%bathyT(i,j+1) <= Dmin)) then + if ((G%bathyT(i+1,j) <= Dmask) .or. (G%bathyT(i+1,j+1) <= Dmask) .or. & + (G%bathyT(i,j) <= Dmask) .or. (G%bathyT(i,j+1) <= Dmask)) then G%mask2dBu(I,J) = 0.0 else G%mask2dBu(I,J) = 1.0 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 336a85d5bc..5ac326ee44 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -195,8 +195,9 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) character(len=200) :: topo_edits_file, inputdir ! Strings for file/path character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: i, j, n, ncid, n_edits, i_file, j_file, ndims, sizes(8) - logical :: found logical :: topo_edits_change_mask + real :: min_depth ! The shallowest value of wet points [Z ~> m] + real :: mask_depth ! The depth defining the land-sea boundary [Z ~> m] call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -210,6 +211,18 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call get_param(param_file, mdl, "ALLOW_LANDMASK_CHANGES", topo_edits_change_mask, & "If true, allow topography overrides to change land mask.", & default=.false.) + call get_param(param_file, 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. "//& + "If MASKING_DEPTH is specified, then all depths shallower than "//& + "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & + units="m", default=0.0, scale=m_to_Z) + call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & + "The depth below which to mask points as land points, for which all "//& + "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& + "default value.", & + units="m", default=-9999.0, scale=m_to_Z) + if (mask_depth == -9999.*m_to_Z) mask_depth = min_depth if (len_trim(topo_edits_file)==0) return @@ -249,7 +262,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) i = ig(n) - G%isd_global + 2 ! +1 for python indexing and +1 for ig-isd_global+1 j = jg(n) - G%jsd_global + 2 if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then - if (new_depth(n)/=0.) then + if (new_depth(n)*m_to_Z /= mask_depth) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) @@ -397,7 +410,8 @@ subroutine limit_topography(D, G, param_file, max_depth, US) real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j character(len=40) :: mdl = "limit_topography" ! This subroutine's name. - real :: min_depth, mask_depth + real :: min_depth ! The shallowest value of wet points [Z ~> m] + real :: mask_depth ! The depth defining the land-sea boundary [Z ~> m] call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -410,30 +424,39 @@ subroutine limit_topography(D, G, param_file, max_depth, US) "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & units="m", default=0.0, scale=m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & - "The depth below which to mask the ocean as land.", & + "The depth below which to mask points as land points, for which all "//& + "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& + "default value.", & units="m", default=-9999.0, scale=m_to_Z, do_not_log=.true.) - if (mask_depth > min_depth) then - mask_depth = -9999.0*m_to_Z - call MOM_error(WARNING, "MOM_shared_initialization: limit_topography "//& - 'MASKING_DEPTH is larger than MINIMUM_DEPTH and therefore ignored.') - endif - ! Make sure that min_depth < D(x,y) < max_depth for ocean points + ! TBD: The following f.p. equivalence uses a special value. Originally, any negative value + ! indicated the branch. We should create a logical flag to indicate this branch. if (mask_depth == -9999.*m_to_Z) then - if (min_depth > 0.0) then ! This is retained to avoid answer changes (over the land points) in the test cases. - do j=G%jsd,G%jed ; do i=G%isd,G%ied - D(i,j) = min( max( D(i,j), 0.5*min_depth ), max_depth ) - enddo ; enddo - else - do j=G%jsd,G%jed ; do i=G%isd,G%ied - D(i,j) = min( max( D(i,j), min_depth ), max_depth ) - enddo ; enddo + if (min_depth<0.) then + call MOM_error(FATAL, trim(mdl)//": MINIMUM_DEPTH<0 does not work as expected "//& + "unless MASKING_DEPTH has been set appropriately. Set a meaningful "//& + "MASKING_DEPTH to enabled negative depths (land elevations) and to "//& + "enable flooding.") endif + ! This is the old path way. The 0.5*min_depth is obscure and is retained to be + ! backward reproducible. If you are looking at the following line you should probably + ! set MASKING_DEPTH. This path way does not work for negative depths, i.e. flooding. + do j=G%jsd,G%jed ; do i=G%isd,G%ied + D(i,j) = min( max( D(i,j), 0.5*min_depth ), max_depth ) + enddo ; enddo else + ! This is the preferred path way. + ! mask_depth has a meaningful value; anything shallower than mask_depth is land. + ! If min_depth mask_depth) then + if (D(i,j) > min(min_depth,mask_depth)) then D(i,j) = min( max( D(i,j), min_depth ), max_depth ) + else + ! This statement is required for cases with masked-out PEs over the land, + ! to remove the large initialized values (-9e30) from the halos. + D(i,j) = min(min_depth,mask_depth) endif enddo ; enddo endif @@ -894,17 +917,17 @@ subroutine reset_face_lengths_list(G, param_file, US) if (num_lines > 0) then allocate(lines(num_lines)) - allocate(u_lat(2,num_lines)) ; u_lat(:,:) = -1e34 - allocate(u_lon(2,num_lines)) ; u_lon(:,:) = -1e34 - allocate(u_width(num_lines)) ; u_width(:) = -1e34 - allocate(u_line_used(num_lines)) ; u_line_used(:) = 0 - allocate(u_line_no(num_lines)) ; u_line_no(:) = 0 - - allocate(v_lat(2,num_lines)) ; v_lat(:,:) = -1e34 - allocate(v_lon(2,num_lines)) ; v_lon(:,:) = -1e34 - allocate(v_width(num_lines)) ; v_width(:) = -1e34 - allocate(v_line_used(num_lines)) ; v_line_used(:) = 0 - allocate(v_line_no(num_lines)) ; v_line_no(:) = 0 + allocate(u_lat(2,num_lines), source=-1e34) + allocate(u_lon(2,num_lines), source=-1e34) + allocate(u_width(num_lines), source=-1e34) + allocate(u_line_used(num_lines), source=0) + allocate(u_line_no(num_lines), source=0) + + allocate(v_lat(2,num_lines), source=-1e34) + allocate(v_lon(2,num_lines), source=-1e34) + allocate(v_width(num_lines), source=-1e34) + allocate(v_line_used(num_lines), source=0) + allocate(v_line_no(num_lines), source=0) ! Actually read the lines. if (is_root_pe()) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f8c772348..1ca466b7fa 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -11,7 +11,7 @@ module MOM_state_initialization use MOM_cpu_clock, only : CLOCK_ROUTINE, CLOCK_LOOP use MOM_domains, only : pass_var, pass_vector, sum_across_PEs, broadcast use MOM_domains, only : root_PE, To_All, SCALAR_PAIR, CGRID_NE, AGRID -use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, NOTE, WARNING, is_root_pe +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type use MOM_file_parser, only : log_version @@ -149,6 +149,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & optional, intent(in) :: frac_shelf_h !< The fraction of the grid cell covered !! by a floating ice shelf [nondim]. ! Local variables + real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] character(len=200) :: filename ! The name of an input file. character(len=200) :: filename2 ! The name of an input files. character(len=200) :: inputdir ! The directory where NetCDF input files are. @@ -179,8 +180,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & logical :: debug_layers = .false. logical :: use_ice_shelf character(len=80) :: mesg -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -227,6 +228,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !enddo endif + ! Set the nominal depth of the ocean, which might be different from the bathymetric + ! geopotential height, for use by the various initialization routines. G%bathyT has + ! already been initialized in previous calls. + do j=jsd,jed ; do i=isd,ied + depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref + enddo ; enddo + ! The remaining initialization calls are done, regardless of whether the ! fields are actually initialized here (if just_read=.false.) or whether it ! is just to make sure that all valid parameters are read to enable the @@ -241,8 +249,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//& "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") - call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params=just_read,& - frac_shelf_h=frac_shelf_h) + call MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, & + just_read_params=just_read, frac_shelf_h=frac_shelf_h) else ! Initialize thickness, h. call get_param(PF, mdl, "THICKNESS_CONFIG", config, & @@ -275,9 +283,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & default="uniform", do_not_log=just_read) select case (trim(config)) case ("file") - call initialize_thickness_from_file(h, G, GV, US, PF, .false., just_read_params=just_read) + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .false., just_read_params=just_read) case ("thickness_file") - call initialize_thickness_from_file(h, G, GV, US, PF, .true., just_read_params=just_read) + call initialize_thickness_from_file(h, depth_tot, G, GV, US, PF, .true., just_read_params=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -285,37 +293,37 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call MOM_error(FATAL, "MOM_initialize_state: USE_REGRIDDING must be True "//& "for THICKNESS_CONFIG of 'coord'") endif - case ("uniform"); call initialize_thickness_uniform(h, G, GV, PF, & + case ("uniform"); call initialize_thickness_uniform(h, depth_tot, G, GV, PF, & just_read_params=just_read) - case ("list"); call initialize_thickness_list(h, G, GV, US, PF, & + case ("list"); call initialize_thickness_list(h, depth_tot, G, GV, US, PF, & just_read_params=just_read) - case ("DOME"); call DOME_initialize_thickness(h, G, GV, PF, & + case ("DOME"); call DOME_initialize_thickness(h, depth_tot, G, GV, PF, & just_read_params=just_read) - case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, US, PF, tv, & + case ("ISOMIP"); call ISOMIP_initialize_thickness(h, depth_tot, G, GV, US, PF, tv, & just_read_params=just_read) - case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, US, PF, & + case ("benchmark"); call benchmark_initialize_thickness(h, depth_tot, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) - case ("Neverwoorld","Neverland"); call Neverworld_initialize_thickness(h, G, GV, US, PF, & + case ("Neverworld","Neverland"); call Neverworld_initialize_thickness(h, depth_tot, G, GV, US, PF, & tv%eqn_of_state, tv%P_Ref) - case ("search"); call initialize_thickness_search - case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & + case ("search"); call initialize_thickness_search() + case ("circle_obcs"); call circle_obcs_initialize_thickness(h, depth_tot, G, GV, PF, & just_read_params=just_read) case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) case ("external_gwave"); call external_gwave_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) - case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, US, PF, & + case ("DOME2D"); call DOME2d_initialize_thickness(h, depth_tot, G, GV, US, PF, & just_read_params=just_read) case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) - case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, US, PF, & + case ("sloshing"); call sloshing_initialize_thickness(h, depth_tot, G, GV, US, PF, & just_read_params=just_read) - case ("seamount"); call seamount_initialize_thickness(h, G, GV, US, PF, & + case ("seamount"); call seamount_initialize_thickness(h, depth_tot, G, GV, US, PF, & just_read_params=just_read) - case ("dumbbell"); call dumbbell_initialize_thickness(h, G, GV, US, PF, & + case ("dumbbell"); call dumbbell_initialize_thickness(h, depth_tot, G, GV, US, PF, & just_read_params=just_read) - case ("soliton"); call soliton_initialize_thickness(h, G, GV, US) - case ("phillips"); call Phillips_initialize_thickness(h, G, GV, US, PF, & + case ("soliton"); call soliton_initialize_thickness(h, depth_tot, G, GV, US) + case ("phillips"); call Phillips_initialize_thickness(h, depth_tot, G, GV, US, PF, & just_read_params=just_read) case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, US, & PF, just_read_params=just_read) @@ -363,11 +371,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, US, PF, eos, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, US, PF, eos, just_read_params=just_read) case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, PF, eos, just_read_params=just_read) case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & - tv%S, h, G, GV, US, PF, just_read_params=just_read) + tv%S, h, depth_tot, G, GV, US, PF, just_read_params=just_read) case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & tv%S, h, G, GV, PF, eos, just_read_params=just_read) case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & @@ -547,22 +555,22 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") select case (trim(config)) - case ("DOME"); call DOME_initialize_sponges(G, GV, US, tv, PF, sponge_CSp) - case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, US, tv, PF, useALE, & + case ("DOME"); call DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, sponge_CSp) + case ("DOME2D"); call DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, PF, useALE, & + case ("ISOMIP"); call ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case("RGC"); call RGC_initialize_sponges(G, GV, US, tv, u, v, PF, useALE, & + case("RGC"); call RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("USER"); call user_initialize_sponges(G, GV, use_temperature, tv, PF, sponge_CSp, h) - case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, PF, & + case ("BFB"); call BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, depth_tot, PF, & sponge_CSp, h) - case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, US, tv, PF, useALE, & + case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, PF, useALE, & sponge_CSp, ALE_sponge_CSp) case ("phillips"); call Phillips_initialize_sponges(G, GV, US, tv, PF, sponge_CSp, h) - case ("dense"); call dense_water_initialize_sponges(G, GV, US, tv, PF, useALE, & + case ("dense"); call dense_water_initialize_sponges(G, GV, US, tv, depth_tot, PF, useALE, & sponge_CSp, ALE_sponge_CSp) - case ("file"); call initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, PF, & + case ("file"); call initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_tot, PF, & sponge_CSp, ALE_sponge_CSp, Time) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized sponge configuration "//trim(config)) @@ -639,14 +647,16 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & end subroutine MOM_initialize_state !> Reads the layer thicknesses or interface heights from a file. -subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thickness, & +subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, file_has_thickness, & just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: file_has_thickness !< If true, this file contains layer !! thicknesses; otherwise it contains @@ -655,7 +665,7 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi !! only read parameters without changing h. ! Local variables - real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units. + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. integer :: inconsistent = 0 logical :: correct_thickness logical :: just_read ! If true, just read parameters but set nothing. @@ -696,7 +706,7 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=US%m_to_Z) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, eta, h) + call adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then @@ -708,7 +718,7 @@ subroutine initialize_thickness_from_file(h, G, GV, US, param_file, file_has_thi enddo ; enddo ; enddo do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + G%bathyT(i,j)) > 1.0*US%m_to_Z) & + if (abs(eta(i,j,nz+1) + depth_tot(i,j)) > 1.0*US%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -732,25 +742,30 @@ end subroutine initialize_thickness_from_file !! 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 adjustEtaToFitBathymetry(G, GV, US, eta, h) +subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, optional, intent(in) :: dZ_ref_eta !< The difference between the + !! reference heights for bathyT and + !! eta [Z ~> m], 0 by default. ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] - real :: hTmp, eTmp, dilate + real :: dilate ! A factor by which the column is dilated [nondim] + real :: dZ_ref ! The difference in the reference heights for G%bathyT and eta [Z ~> m] character(len=100) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke hTolerance = 0.1*US%m_to_Z + dZ_ref = 0.0 ; if (present(dZ_ref_eta)) dZ_ref = dZ_ref_eta contractions = 0 do j=js,je ; do i=is,ie - if (-eta(i,j,nz+1) > G%bathyT(i,j) + hTolerance) then - eta(i,j,nz+1) = -G%bathyT(i,j) + if (-eta(i,j,nz+1) > (G%bathyT(i,j) + dZ_ref) + hTolerance) then + eta(i,j,nz+1) = -(G%bathyT(i,j) + dZ_ref) contractions = contractions + 1 endif enddo ; enddo @@ -779,12 +794,12 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. ! This should be... if ((G%mask2dt(i,j)*(eta(i,j,1)-eta(i,j,nz+1)) > 0.0) .and. & - if (-eta(i,j,nz+1) < G%bathyT(i,j) - hTolerance) then + if (-eta(i,j,nz+1) < (G%bathyT(i,j) + dZ_ref) - hTolerance) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then - do k=1,nz ; h(i,j,k) = (eta(i,j,1) + G%bathyT(i,j)) / real(nz) ; enddo + do k=1,nz ; h(i,j,k) = (eta(i,j,1) + (G%bathyT(i,j) + dZ_ref)) / real(nz) ; enddo else - dilate = (eta(i,j,1) + G%bathyT(i,j)) / (eta(i,j,1) - eta(i,j,nz+1)) + dilate = (eta(i,j,1) + (G%bathyT(i,j) + dZ_ref)) / (eta(i,j,1) - eta(i,j,nz+1)) do k=1,nz ; h(i,j,k) = h(i,j,k) * dilate ; enddo endif do k=nz,2,-1 ; eta(i,j,K) = eta(i,j,K+1) + h(i,j,k) ; enddo @@ -806,11 +821,13 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h) end subroutine adjustEtaToFitBathymetry !> Initializes thickness to be uniform -subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) +subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -845,7 +862,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then @@ -861,12 +878,14 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) end subroutine initialize_thickness_uniform !> Initialize thickness from a 1D list -subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) +subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -921,7 +940,7 @@ subroutine initialize_thickness_list(h, G, GV, US, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! based on the resting depths and interface height perturbations, ! as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then @@ -1067,7 +1086,7 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read_params) call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) ! Convert thicknesses to interface heights. - call find_eta(h, tv, G, GV, US, eta) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then ! if (eta_sfc(i,j) < eta(i,j,nz+1)) then @@ -1180,7 +1199,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, US, GV%g_Earth, G%bathyT(i,j), & + call cut_off_column_top(GV%ke, tv, GV, US, GV%g_Earth, G%bathyT(i,j)+G%Z_ref, & 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, remap_answers_2018=remap_answers_2018) @@ -1738,19 +1757,22 @@ end subroutine initialize_temp_salt_linear !! number of tracers should be restored within each sponge. The !! interface height is always subject to damping, and must always be !! the first registered field. -subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, param_file, Layer_CSp, ALE_CSp, Time) +subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_tot, param_file, & + Layer_CSp, ALE_CSp, Time) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_temperature !< If true, T & S are state variables. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic !! variables. real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u !< The zonal velocity that is being - !! initialized [L T-1 ~> m s-1] + intent(in) :: u !< The zonal velocity that is being + !! initialized [L T-1 ~> m s-1] real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v !< The meridional velocity that is being - !! initialized [L T-1 ~> m s-1] + intent(in) :: v !< The meridional velocity that is being + !! initialized [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(sponge_CS), pointer :: Layer_CSp !< A pointer that is set to point to the control !! structure for this module (in layered mode). @@ -1907,11 +1929,11 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, param_f if (.not. use_ALE) then ! The first call to set_up_sponge_field is for the interface heights if in layered mode. - allocate(eta(isd:ied,jsd:jed,nz+1)); eta(:,:,:) = 0.0 + allocate(eta(isd:ied,jsd:jed,nz+1), source=0.0) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -depth_tot(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & @@ -1972,7 +1994,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, param_f allocate(h(isd:ied,jsd:jed,nz_data)) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) do j=js,je ; do i=is,ie - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -depth_tot(i,j) enddo ; enddo do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) & @@ -2172,9 +2194,8 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p call log_param(param_file, mdl, "INPUTDIR/ODA_INCUPD_UV_FILE", filename) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " initialize_oda_incupd_uv: Unable to open "//trim(filename)) - allocate(tmp_u(G%IsdB:G%IedB,jsd:jed,nz_data)) - allocate(tmp_v(isd:ied,G%JsdB:G%JedB,nz_data)) - tmp_u(:,:,:) = 0.0 ; tmp_v(:,:,:) = 0.0 + allocate(tmp_u(G%IsdB:G%IedB,jsd:jed,nz_data), source=0.0) + allocate(tmp_v(isd:ied,G%JsdB:G%JedB,nz_data), source=0.0) call MOM_read_vector(filename, uinc_var, vinc_var, tmp_u, tmp_v, G%Domain,scale=US%m_s_to_L_T) call set_up_oda_incupd_vel_field(tmp_u, tmp_v, G, GV, oda_incupd_CSp) deallocate(tmp_u,tmp_v) @@ -2182,9 +2203,9 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p ! calculate increments if input are full fields if (oda_inc) then ! input are increments - if (is_root_pe()) call MOM_error(NOTE,"incupd using increments fields ") + if (is_root_pe()) call MOM_mesg("incupd using increments fields ") else ! inputs are full fields - if (is_root_pe()) call MOM_error(NOTE,"incupd using full fields ") + if (is_root_pe()) call MOM_mesg("incupd using full fields ") call calc_oda_increments(h, tv, u, v, G, GV, US, oda_incupd_CSp) if (save_inc) then call output_oda_incupd_inc(Time, G, GV, param_file, oda_incupd_CSp, US) @@ -2251,13 +2272,15 @@ end subroutine set_velocity_depth_min !> This subroutine determines the isopycnal or other coordinate interfaces and !! layer potential temperatures and salinities directly from a z-space file on !! a latitude-longitude grid. -subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_params, frac_shelf_h) +subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just_read_params, frac_shelf_h) 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(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< Layer thicknesses being initialized [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic !! variables including temperature and salinity + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. @@ -2319,6 +2342,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: zi ! Interface heights [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)) :: Z_bottom ! The (usually negative) height of the seafloor + ! relative to the surface [Z ~> m]. integer, dimension(SZI_(G),SZJ_(G)) :: nlevs real, dimension(SZI_(G)) :: press ! Pressures [R L2 T-2 ~> Pa]. @@ -2513,6 +2538,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param call pass_var(mask_z,G%Domain) call pass_var(rho_z,G%Domain) + do j=js,je ; do i=is,ie + Z_bottom(i,j) = -depth_tot(i,j) + enddo ; enddo + ! Done with horizontal interpolation. ! Now remap to model coordinates if (useALEremapping) then @@ -2520,21 +2549,21 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param nkd = max(GV%ke, kd) ! Build the source grid and copy data onto model-shaped arrays with vanished layers - allocate( tmp_mask_in(isd:ied,jsd:jed,nkd) ) ; tmp_mask_in(:,:,:) = 0. - allocate( h1(isd:ied,jsd:jed,nkd) ) ; h1(:,:,:) = 0. - allocate( tmpT1dIn(isd:ied,jsd:jed,nkd) ) ; tmpT1dIn(:,:,:) = 0. - allocate( tmpS1dIn(isd:ied,jsd:jed,nkd) ) ; tmpS1dIn(:,:,:) = 0. + allocate( tmp_mask_in(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( h1(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( tmpT1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( tmpS1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then zTopOfCell = 0. ; zBottomOfCell = 0. tmp_mask_in(i,j,1:kd) = mask_z(i,j,:) do k = 1, nkd if (tmp_mask_in(i,j,k)>0. .and. k<=kd) then - zBottomOfCell = max( z_edges_in(k+1), -G%bathyT(i,j) ) + zBottomOfCell = max( z_edges_in(k+1), Z_bottom(i,j)) tmpT1dIn(i,j,k) = temp_z(i,j,k) tmpS1dIn(i,j,k) = salt_z(i,j,k) elseif (k>1) then - zBottomOfCell = -G%bathyT(i,j) + zBottomOfCell = Z_bottom(i,j) tmpT1dIn(i,j,k) = tmpT1dIn(i,j,k-1) tmpS1dIn(i,j,k) = tmpS1dIn(i,j,k-1) else ! This next block should only ever be reached over land @@ -2544,7 +2573,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + h1(i,j,kd) = h1(i,j,kd) + GV%Z_to_H * max(0., zTopOfCell - Z_bottom(i,j) ) ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo @@ -2567,7 +2596,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz - zBottomOfCell = max( zTopOfCell - hTarget(k), -G%bathyT(i,j) ) + zBottomOfCell = max( zTopOfCell - hTarget(k), Z_bottom(i,j)) h(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo @@ -2624,11 +2653,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param nkml = 0 ; if (separate_mixed_layer) nkml = GV%nkml - call find_interfaces(rho_z, z_in, kd, Rb, G%bathyT, zi, G, GV, US, nlevs, nkml, & + call find_interfaces(rho_z, z_in, kd, Rb, Z_bottom, zi, G, GV, US, nlevs, nkml, & Hmix_depth, eps_z, eps_rho, density_extrap_bug) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, zi, h) + call adjustEtaToFitBathymetry(G, GV, US, zi, h, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then @@ -2640,7 +2669,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, US, PF, just_read_param enddo ; enddo ; enddo inconsistent=0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) + G%bathyT(i,j)) > 1.0*US%m_to_Z) & + if (abs(zi(i,j,nz+1) - Z_bottom(i,j)) > 1.0*US%m_to_Z) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -2710,7 +2739,7 @@ end subroutine MOM_temp_salt_initialize_from_Z !> Find interface positions corresponding to interpolated depths in a density profile -subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, GV, US, nlevs, nkml, hml, & +subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, nkml, hml, & eps_z, eps_rho, density_extrap_bug) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -2720,7 +2749,8 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, GV, US, nlevs, n real, dimension(nk_data), intent(in) :: zin !< Input data levels [Z ~> m]. real, dimension(SZK_(GV)+1), intent(in) :: Rb !< target interface densities [R ~> kg m-3] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: depth !< ocean depth [Z ~> m]. + intent(in) :: Z_bot !< The (usually negative) height of the seafloor + !! relative to the surface [Z ~> m]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: zi !< The returned interface heights [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -2793,30 +2823,42 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, depth, zi, G, GV, US, nlevs, n ! Find and store the interface depths. zi_(1) = 0.0 - do K=2,nz - ! Find the value of k_int in the list of rho_ where rho_(k_int) <= Rb(K) < rho_(k_int+1). - ! This might be made a little faster by exploiting the fact that Rb is - ! monotonically increasing and not resetting lo_int back to 1 inside the K loop. - lo_int = 1 ; hi_int = nlevs_data - do while (lo_int < hi_int) - mid = (lo_int+hi_int) / 2 - if (Rb(K) < rho_(mid)) then ; hi_int = mid - else ; lo_int = mid+1 ; endif + if (nlevs_data < 1) then + ! There is no data to use, so set the interfaces at the bottom. + do K=2,nz ; zi_(K) = Z_bot(i,j) ; enddo + elseif (nlevs_data == 1) then + ! There is data for only one input layer, so set the interfaces at the bottom or top, + ! depending on how their target densities compare with the one data point. + do K=2,nz + if (Rb(K) < rho_(1)) then ; zi_(K) = 0.0 + else ; zi_(K) = Z_bot(i,j) ; endif enddo - k_int = max(1, lo_int-1) + else + do K=2,nz + ! Find the value of k_int in the list of rho_ where rho_(k_int) <= Rb(K) < rho_(k_int+1). + ! This might be made a little faster by exploiting the fact that Rb is + ! monotonically increasing and not resetting lo_int back to 1 inside the K loop. + lo_int = 1 ; hi_int = nlevs_data + do while (lo_int < hi_int) + mid = (lo_int+hi_int) / 2 + if (Rb(K) < rho_(mid)) then ; hi_int = mid + else ; lo_int = mid+1 ; endif + enddo + k_int = max(1, lo_int-1) - ! Linearly interpolate to find the depth, zi_, where Rb would be found. - slope = (zin(k_int+1) - zin(k_int)) / max(rho_(k_int+1) - rho_(k_int), eps_rho) - zi_(K) = -1.0*(zin(k_int) + slope*(Rb(K)-rho_(k_int))) - zi_(K) = min(max(zi_(K), -depth(i,j)), -1.0*hml) - enddo - zi_(nz+1) = -depth(i,j) + ! Linearly interpolate to find the depth, zi_, where Rb would be found. + slope = (zin(k_int+1) - zin(k_int)) / max(rho_(k_int+1) - rho_(k_int), eps_rho) + zi_(K) = -1.0*(zin(k_int) + slope*(Rb(K)-rho_(k_int))) + zi_(K) = min(max(zi_(K), Z_bot(i,j)), -1.0*hml) + enddo + endif + zi_(nz+1) = Z_bot(i,j) if (nkml > 0) then ; do K=2,nkml+1 - zi_(K) = max(hml*((1.0-real(K))/real(nkml)), -depth(i,j)) + zi_(K) = max(hml*((1.0-real(K))/real(nkml)), Z_bot(i,j)) enddo ; endif do K=nz,max(nkml+2,2),-1 if (zi_(K) < zi_(K+1) + eps_Z) zi_(K) = zi_(K+1) + eps_Z - if (zi_(K) > -1.0*hml) zi_(K) = max(-1.0*hml, -depth(i,j)) + if (zi_(K) > -1.0*hml) zi_(K) = max(-1.0*hml, Z_bot(i,j)) enddo do K=1,nz+1 @@ -2864,7 +2906,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) S_t(k) = 35. - (0. * I_z_scale)*e(k) S(k) = 35. + (0. * I_z_scale)*z(k) S_b(k) = 35. - (0. * I_z_scale)*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%g_Earth*z(k), & rho(k), tv%eqn_of_state) P_tot = P_tot + GV%g_Earth * rho(k) * GV%H_to_Z*h(k) enddo diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 48b67bf295..8a67d71fe2 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -152,7 +152,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ if (G%mask2dT(i,j)>0.) then ! Build the source grid zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0 - z_bathy = G%bathyT(i,j) + z_bathy = G%bathyT(i,j) + G%Z_ref do k = 1, kd if (mask_z(i,j,k) > 0.) then zBottomOfCell = -min( z_edges_in(k+1), z_bathy ) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 8057234cdc..6c36cbbacb 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -9,23 +9,32 @@ module MOM_oda_driver_mod use MOM_domains, only : domain2d, global_field, get_domain_extent use MOM_domains, only : pass_var, redistribute_array, broadcast_domain use MOM_diag_mediator, only : register_diag_field, diag_axis_init, post_data +use MOM_diag_mediator, only : enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_update_remap_grids use MOM_ensemble_manager, only : get_ensemble_id, get_ensemble_size use MOM_ensemble_manager, only : get_ensemble_pelist, get_ensemble_filter_pelist use MOM_error_handler, only : stdout, stdlog, MOM_error use MOM_io, only : SINGLE_FILE +use MOM_interp_infra, only : init_extern_field, get_external_field_info +use MOM_interp_infra, only : time_interp_extern use MOM_time_manager, only : time_type, real_to_time, get_date use MOM_time_manager, only : operator(+), operator(>=), operator(/=) use MOM_time_manager, only : operator(==), operator(<) - +use MOM_cpu_clock, only : cpu_clock_begin, cpu_clock_end, cpu_clock_id +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer ! ODA Modules use ocean_da_types_mod, only : grid_type, ocean_profile_type, ocean_control_struct use ocean_da_core_mod, only : ocean_da_core_init, get_profiles +!This preprocessing directive enables the SPEAR online ensemble data assimilation +!configuration. Existing community based APIs for data assimilation are currently +!called offline for forecast applications using information read from a MOM6 state file. +!The SPEAR configuration (https://doi.org/10.1029/2020MS002149) calculated increments +!efficiently online. A community-based set of APIs should be implemented in place +!of the CPP directive when this is available. #ifdef ENABLE_ECDA use eakf_oda_mod, only : ensemble_filter #endif -use write_ocean_obs_mod, only : open_profile_file -use write_ocean_obs_mod, only : write_profile,close_profile_file -use kdtree, only : kd_root !# JEDI +use kdtree, only : kd_root !# A kd-tree object using JEDI APIs ! MOM Modules use MOM_io, only : slasher, MOM_read_data use MOM_diag_mediator, only : diag_ctrl, set_axes_info @@ -52,7 +61,16 @@ module MOM_oda_driver_mod implicit none ; private public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer -public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments +public :: set_analysis_time, oda, apply_oda_tracer_increments + +!>@{ CPU time clock ID +integer :: id_clock_oda_init +integer :: id_clock_oda_filter +integer :: id_clock_bias_adjustment +integer :: id_clock_apply_increments +integer :: id_clock_oda_prior +integer :: id_clock_oda_posterior +!>@} #include @@ -61,13 +79,23 @@ module MOM_oda_driver_mod type(domain2d), pointer :: mpp_domain => NULL() !< pointer to a domain2d end type ptr_mpp_domain +!> A structure containing integer handles for bias adjustment of tracers +type :: INC_CS + integer :: fldno = 0 !< The number of tracers + integer :: T_id !< The integer handle for the temperature file + integer :: S_id !< The integer handle for the salinity file +end type INC_CS + !> Control structure that contains a transpose of the ocean state across ensemble members. type, public :: ODA_CS ; private type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states !! or increments to prior in DA space + type(ocean_control_struct), pointer :: Ocean_increment=> NULL() !< A separate structure for + !! increment diagnostics integer :: nk !< number of vertical layers used for DA type(ocean_grid_type), pointer :: Grid => NULL() !< MOM6 grid type and decomposition for the DA + type(ocean_grid_type), pointer :: G => NULL() !< MOM6 grid type and decomposition for the model type(MOM_domain_type), pointer, dimension(:) :: domains => NULL() !< Pointer to mpp_domain objects !! for ensemble members type(verticalGrid_type), pointer :: GV => NULL() !< vertical grid for DA @@ -78,12 +106,17 @@ module MOM_oda_driver_mod type(grid_type), pointer :: oda_grid !< local tracer grid real, pointer, dimension(:,:,:) :: h => NULL() ! m or kg m-2] for DA type(thermo_var_ptrs), pointer :: tv => NULL() !< pointer to thermodynamic variables + type(thermo_var_ptrs), pointer :: tv_bc => NULL() !< pointer to thermodynamic bias correction integer :: ni !< global i-direction grid size integer :: nj !< global j-direction grid size logical :: reentrant_x !< grid is reentrant in the x direction logical :: reentrant_y !< grid is reentrant in the y direction logical :: tripolar_N !< grid is folded at its north edge logical :: symmetric !< Values at C-grid locations are symmetric + logical :: use_basin_mask !< If true, use a basin file to delineate weakly coupled ocean basins + logical :: do_bias_adjustment !< If true, use spatio-temporally varying climatological tendency + !! adjustment for Temperature and Salinity + real :: bias_adjustment_multiplier !< A scaling for the bias adjustment integer :: assim_method !< Method: NO_ASSIM,EAKF_ASSIM or OI_ASSIM integer :: ensemble_size !< Size of the ensemble integer :: ensemble_id = 0 !< id of the current ensemble member @@ -99,7 +132,10 @@ module MOM_oda_driver_mod type(regridding_CS) :: regridCS !< ALE control structure for regridding type(remapping_CS) :: remapCS !< ALE control structure for remapping type(time_type) :: Time !< Current Analysis time - type(diag_ctrl) :: diag_cs ! NULL() ! initialize First_guess (prior) and Analysis grid !! information for all ensemble members -subroutine init_oda(Time, G, GV, CS) +subroutine init_oda(Time, G, GV, diag_CS, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(diag_ctrl), target, intent(inout) :: diag_CS !< A pointer to a diagnostic control structure type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure ! Local variables @@ -133,6 +170,7 @@ subroutine init_oda(Time, G, GV, CS) integer :: isg,ieg,jsg,jeg integer :: idg_offset, jdg_offset integer :: stdout_unit + integer, dimension(4) :: fld_sz character(len=32) :: assim_method integer :: npes_pm, ens_info(6), ni, nj character(len=128) :: mesg @@ -140,14 +178,21 @@ subroutine init_oda(Time, G, GV, CS) character(len=30) :: coord_mode character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric + character(len=80) :: bias_correction_file, inc_file if (associated(CS)) call MOM_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) + + id_clock_oda_init=cpu_clock_id('(ODA initialization)') + id_clock_oda_prior=cpu_clock_id('(ODA setting prior)') + id_clock_oda_filter=cpu_clock_id('(ODA filter computation)') + id_clock_oda_posterior=cpu_clock_id('(ODA getting posterior)') + call cpu_clock_begin(id_clock_oda_init) + ! Use ens1 parameters , this could be changed at a later time ! if it were desirable to have alternate parameters, e.g. for the grid ! for the analysis call get_MOM_input(PF,dirs,ensemble_num=0) - call unit_scaling_init(PF, CS%US) call get_param(PF, "MOM", "ASSIM_METHOD", assim_method, & @@ -167,6 +212,20 @@ subroutine init_oda(Time, G, GV, CS) "Use tripolar connectivity at the northern edge of the "//& "domain. With TRIPOLAR_N, NIGLOBAL must be even.", & default=.false.) + call get_param(PF,"MOM", "APPLY_TRACER_TENDENCY_ADJUSTMENT", CS%do_bias_adjustment, & + "If true, add a spatio-temporally varying climatological adjustment "//& + "to temperature and salinity.", & + default=.false.) + if (CS%do_bias_adjustment) then + call get_param(PF,"MOM", "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & + "A multiplicative scaling factor for the climatological tracer tendency adjustment ", & + default=1.0) + endif + call get_param(PF,"MOM", "USE_BASIN_MASK", CS%use_basin_mask, & + "If true, add a basin mask to delineate weakly connected "//& + "ocean basins for the purpose of data assimilation.", & + default=.false.) + call get_param(PF,"MOM", "NIGLOBAL", CS%ni, & "The total number of thickness grid points in the "//& "x-direction in the physical domain.") @@ -200,19 +259,19 @@ subroutine init_oda(Time, G, GV, CS) call set_PElist(CS%filter_pelist) allocate(CS%domains(CS%ensemble_size)) - CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain + CS%domains(CS%ensemble_id)%mpp_domain => G%Domain%mpp_domain ! this should go away do n=1,CS%ensemble_size if (.not. associated(CS%domains(n)%mpp_domain)) allocate(CS%domains(n)%mpp_domain) - call set_rootPE(CS%ensemble_pelist(n,1)) + call set_rootPE(CS%ensemble_pelist(n,1)) ! this line is not in Feiyu's version (needed?) call broadcast_domain(CS%domains(n)%mpp_domain) enddo - call set_rootPE(CS%filter_pelist(1)) + call set_rootPE(CS%filter_pelist(1)) ! this line is not in Feiyu's version (needed?) + CS%G => G allocate(CS%Grid) ! params NIHALO_ODA, NJHALO_ODA set the DA halo size call MOM_domains_init(CS%Grid%Domain,PF,param_suffix='_ODA') allocate(HI) - call hor_index_init(CS%Grid%Domain, HI, PF, & - local_indexing=.false.) ! Use global indexing for DA + call hor_index_init(CS%Grid%Domain, HI, PF) call verticalGridInit( PF, CS%GV, CS%US ) allocate(dG) call create_dyn_horgrid(dG, HI) @@ -222,7 +281,7 @@ subroutine init_oda(Time, G, GV, CS) call MOM_initialize_coord(CS%GV, CS%US, PF, .false., & 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 MOM_grid_init(CS%Grid, PF) 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 @@ -233,7 +292,9 @@ subroutine init_oda(Time, G, GV, CS) call init_ocean_ensemble(CS%Ocean_prior,CS%Grid,CS%GV,CS%ensemble_size) allocate(CS%Ocean_posterior) call init_ocean_ensemble(CS%Ocean_posterior,CS%Grid,CS%GV,CS%ensemble_size) - allocate(CS%tv) + allocate(CS%Ocean_increment) + call init_ocean_ensemble(CS%Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) + call get_param(PF, 'oda_driver', "REGRIDDING_COORDINATE_MODE", coord_mode, & "Coordinate mode for vertical regridding.", & @@ -241,76 +302,79 @@ subroutine init_oda(Time, G, GV, CS) call initialize_regridding(CS%regridCS, CS%GV, CS%US, dG%max_depth,PF,'oda_driver',coord_mode,'','') call initialize_remapping(CS%remapCS,'PLM') call set_regrid_params(CS%regridCS, min_thickness=0.) + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed + ! breaking with the MOM6 convention and using global indices - call get_domain_extent(G%Domain,is,ie,js,je,isd,ied,jsd,jed,& - isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) - isd=isd+idg_offset; ied=ied+idg_offset - jsd=jsd+jdg_offset; jed=jed+jdg_offset - !call mpp_get_data_domain(G%Domain%mpp_domain,isd,ied,jsd,jed) + !call get_domain_extent(G%Domain,is,ie,js,je,isd,ied,jsd,jed,& + ! isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) + !isd=isd+idg_offset; ied=ied+idg_offset ! using global indexing within the DA module + !jsd=jsd+jdg_offset; jed=jed+jdg_offset ! TODO: switch to local indexing? (mjh) + if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=0.0 + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_m*CS%GV%H_to_m) ! assign thicknesses call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) endif - allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0 - allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 - call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) - ! get domain extents for the analysis grid and use global indexing - !call get_domain_extent(CS%Grid%Domain,is,ie,js,je,isd,ied,jsd,jed,& - ! isg,ieg,jsg,jeg,idg_offset,jdg_offset,symmetric) - !isd=isd+idg_offset; ied=ied+idg_offset - !jsd=jsd+jdg_offset; jed=jed+jdg_offset - !call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) + allocate(CS%tv) + allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke), source=0.0) + allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke), source=0.0) +! call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) ! missing in Feiyu's fork allocate(CS%oda_grid) CS%oda_grid%x => CS%Grid%geolonT CS%oda_grid%y => CS%Grid%geolatT - call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & + + if (CS%use_basin_mask) then + call get_param(PF, 'oda_driver', "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & default="basin.nc") - basin_file = trim(inputdir) // trim(basin_file) - allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed)) - CS%oda_grid%basin_mask(:,:) = 0.0 - call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) - -! get global grid information from ocean_model - allocate(T_grid) - allocate(T_grid%x(CS%ni,CS%nj)) - allocate(T_grid%y(CS%ni,CS%nj)) - allocate(T_grid%basin_mask(CS%ni,CS%nj)) - call global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) - call global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) - call global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) - T_grid%ni = CS%ni - T_grid%nj = CS%nj - T_grid%nk = CS%nk - allocate(T_grid%mask(CS%ni,CS%nj,CS%nk)) - allocate(T_grid%z(CS%ni,CS%nj,CS%nk)) - allocate(global2D(CS%ni,CS%nj)) - allocate(global2D_old(CS%ni,CS%nj)) - T_grid%mask(:,:,:) = 0.0 - T_grid%z(:,:,:) = 0.0 - - do k = 1, CS%nk - call global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) - do i=1,CS%ni ; do j=1,CS%nj - if ( global2D(i,j) > 1 ) then - T_grid%mask(i,j,k) = 1.0 - endif - enddo ; enddo - if (k == 1) then - T_grid%z(:,:,k) = global2D/2 - else - T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 - endif - global2D_old = global2D - enddo + basin_file = trim(inputdir) // trim(basin_file) + allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed), source=0.0) + call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) + endif - call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) + ! set up diag variables for analysis increments + CS%diag_CS => diag_CS + CS%id_inc_t=register_diag_field('ocean_model','temp_increment',diag_CS%axesTL,& + Time,'ocean potential temperature increments','degC') + CS%id_inc_s=register_diag_field('ocean_model','salt_increment',diag_CS%axesTL,& + Time,'ocean salinity increments','psu') + + !! get global grid information from ocean model needed for ODA initialization + T_grid=>NULL() + call set_up_global_tgrid(T_grid, CS, G) + call ocean_da_core_init(CS%mpp_domain, T_grid, CS%Profiles, Time) + deallocate(T_grid) CS%Time=Time !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) + + if (CS%do_bias_adjustment) then + call get_param(PF, "MOM", "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + "The name of the file containing temperature and salinity "//& + "tendency adjustments", default='temp_salt_adjustment.nc') + + inc_file = trim(inputdir) // trim(bias_correction_file) + CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) + CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) + call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + CS%INC_CS%fldno = 2 + if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') + allocate(CS%tv_bc) ! storage for increment + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + endif + + call cpu_clock_end(id_clock_oda_init) + +! if (CS%write_obs) then +! temp_fid = open_profile_file("temp_"//trim(obs_file)) +! salt_fid = open_profile_file("salt_"//trim(obs_file)) +! end if + end subroutine init_oda !> Copy ensemble member tracers to ensemble vector. @@ -340,7 +404,8 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) - call MOM_mesg('Setting prior') + !call MOM_mesg('Setting prior') + call cpu_clock_begin(id_clock_oda_prior) ! computational domain for the analysis grid isc=CS%Grid%isc;iec=CS%Grid%iec;jsc=CS%Grid%jsc;jec=CS%Grid%jec @@ -367,6 +432,7 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) call pass_var(CS%Ocean_prior%S(:,:,:,m),CS%Grid%domain) enddo + call cpu_clock_end(id_clock_oda_prior) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -379,28 +445,31 @@ end subroutine set_prior_tracer subroutine get_posterior_tracer(Time, CS, h, tv, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - real, dimension(:,:,:), pointer :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables + real, dimension(:,:,:), pointer, optional :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), pointer, optional :: tv !< A structure pointing to various thermodynamic variables logical, optional, intent(in) :: increment !< True if returning increment only type(ocean_control_struct), pointer :: Ocean_increment=>NULL() integer :: i, j, m logical :: used, get_inc + integer :: seconds_per_hour = 3600. ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time) return + if (Time < CS%Time .or. CS%assim_method .eq. NO_ASSIM) return !! switch to global pelist call set_PElist(CS%filter_pelist) call MOM_mesg('Getting posterior') - + call cpu_clock_begin(id_clock_oda_posterior) + if (present(h)) h => CS%h ! get analysis thickness + !! Calculate and redistribute increments to CS%tv right after assimilation + !! Retain CS%tv to calculate increments for IAU updates CS%tv_inc otherwise get_inc = .true. if (present(increment)) get_inc = increment if (get_inc) then allocate(Ocean_increment) - call init_ocean_ensemble(Ocean_increment,CS%Grid,CS%GV,CS%ensemble_size) Ocean_increment%T = CS%Ocean_posterior%T - CS%Ocean_prior%T Ocean_increment%S = CS%Ocean_posterior%S - CS%Ocean_prior%S endif @@ -418,17 +487,28 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) endif enddo - tv => CS%tv - h => CS%h + if (present(tv)) tv => CS%tv + if (present(h)) h => CS%h + + call cpu_clock_end(id_clock_oda_posterior) + !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) + call pass_var(CS%tv%T,CS%domains(CS%ensemble_id)) + call pass_var(CS%tv%S,CS%domains(CS%ensemble_id)) + + !convert to a tendency (degC or PSU per second) + CS%tv%T = CS%tv%T / (CS%assim_frequency * seconds_per_hour) + CS%tv%S = CS%tv%S / (CS%assim_frequency * seconds_per_hour) + + end subroutine get_posterior_tracer !> Gather observations and call ODA routines subroutine oda(Time, CS) type(time_type), intent(in) :: Time !< the current model time - type(oda_CS), intent(inout) :: CS !< the ocean DA control structure + type(oda_CS), pointer :: CS !< A pointer the ocean DA control structure integer :: i, j integer :: m @@ -438,20 +518,61 @@ subroutine oda(Time, CS) !! switch to global pelist call set_PElist(CS%filter_pelist) - + call cpu_clock_begin(id_clock_oda_filter) call get_profiles(Time, CS%Profiles, CS%CProfiles) #ifdef ENABLE_ECDA call ensemble_filter(CS%Ocean_prior, CS%Ocean_posterior, CS%CProfiles, CS%kdroot, CS%mpp_domain, CS%oda_grid) #endif - + call cpu_clock_end(id_clock_oda_filter) !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) + call get_posterior_tracer(Time, CS, increment=.true.) + if (CS%do_bias_adjustment) call get_bias_correction_tracer(Time, CS) endif return end subroutine oda +subroutine get_bias_correction_tracer(Time, CS) + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + + integer :: i,j,k + real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: mask_z + real, allocatable, dimension(:), target :: z_in, z_edges_in + real :: missing_value + integer,dimension(3) :: fld_sz + + call cpu_clock_begin(id_clock_bias_adjustment) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + + ! This should be replaced to use mask_z instead of the following lines + ! which are intended to zero land values using an arbitrary limit. + fld_sz=shape(T_bias) + do i=1,fld_sz(1) + do j=1,fld_sz(2) + do k=1,fld_sz(3) + if (T_bias(i,j,k) .gt. 1.0E-3) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) .gt. 1.0E-3) S_bias(i,j,k) = 0.0 + enddo + enddo + enddo + + CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier + CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + + call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + + call cpu_clock_end(id_clock_bias_adjustment) + + end subroutine get_bias_correction_tracer + !> Finalize DA module subroutine oda_end(CS) type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure @@ -474,13 +595,13 @@ subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) allocate(CS%T(is:ie,js:je,nk,ens_size)) allocate(CS%S(is:ie,js:je,nk,ens_size)) allocate(CS%SSH(is:ie,js:je,ens_size)) -! allocate(CS%id_t(ens_size));CS%id_t(:)=-1 -! allocate(CS%id_s(ens_size));CS%id_s(:)=-1 +! allocate(CS%id_t(ens_size), source=-1) +! allocate(CS%id_s(ens_size), source=-1) ! allocate(CS%U(is:ie,js:je,nk,ens_size)) ! allocate(CS%V(is:ie,js:je,nk,ens_size)) -! allocate(CS%id_u(ens_size));CS%id_u(:)=-1 -! allocate(CS%id_v(ens_size));CS%id_v(:)=-1 -! allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1 +! allocate(CS%id_u(ens_size), source=-1) +! allocate(CS%id_v(ens_size), source=-1) +! allocate(CS%id_ssh(ens_size), source=-1) return end subroutine init_ocean_ensemble @@ -513,45 +634,125 @@ subroutine set_analysis_time(Time,CS) end subroutine set_analysis_time -!> Write observation differences to a file -subroutine save_obs_diff(filename,CS) - character(len=*), intent(in) :: filename !< name of output file - type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure - - integer :: fid ! profile file handle - type(ocean_profile_type), pointer :: Prof=>NULL() - - fid = open_profile_file(trim(filename), nvar=2, thread=SINGLE_FILE, fset=SINGLE_FILE) - Prof=>CS%CProfiles - - !! switch to global pelist - !call set_PElist(CS%filter_pelist) - - do while (associated(Prof)) - call write_profile(fid,Prof) - Prof=>Prof%cnext - enddo - call close_profile_file(fid) - - !! switch back to ensemble member pelist - !call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) - - return -end subroutine save_obs_diff - !> Apply increments to tracers -subroutine apply_oda_tracer_increments(dt, G, GV, tv, h, CS) +subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real, intent(in) :: dt !< The tracer timestep [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] - type(ODA_CS), intent(inout) :: CS !< the data assimilation structure + type(ODA_CS), pointer :: CS !< the data assimilation structure + + !! local variables + integer :: yr, mon, day, hr, min, sec + integer :: i, j, k + integer :: isc, iec, jsc, jec + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_inc !< an adjustment to the temperature + !! tendency [degC T-1 -> degC s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_inc !< an adjustment to the salinity + !! tendency [g kg-1 T-1 -> g kg-1 s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [g kg-1] + real :: missing_value + + if (.not. associated(CS)) return + if (CS%assim_method .eq. NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return + + call cpu_clock_begin(id_clock_apply_increments) + + T_inc(:,:,:) = 0.0; S_inc(:,:,:) = 0.0; T(:,:,:) = 0.0; S(:,:,:) = 0.0 + if (CS%assim_method > 0 ) then + T = T + CS%tv%T + S = S + CS%tv%S + endif + if (CS%do_bias_adjustment ) then + T = T + CS%tv_bc%T + S = S + CS%tv_bc%S + endif + + isc=G%isc; iec=G%iec; jsc=G%jsc; jec=G%jec + do j=jsc,jec; do i=isc,iec + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T(i,j,:), & + G%ke, h(i,j,:), T_inc(i,j,:)) + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S(i,j,:), & + G%ke, h(i,j,:), S_inc(i,j,:)) + enddo; enddo + + + call pass_var(T_inc, G%Domain) + call pass_var(S_inc, G%Domain) + + tv%T(isc:iec,jsc:jec,:)=tv%T(isc:iec,jsc:jec,:)+T_inc(isc:iec,jsc:jec,:)*dt + tv%S(isc:iec,jsc:jec,:)=tv%S(isc:iec,jsc:jec,:)+S_inc(isc:iec,jsc:jec,:)*dt + + call pass_var(tv%T, G%Domain) + call pass_var(tv%S, G%Domain) + + call enable_averaging(dt, Time_end, CS%diag_CS) + if (CS%id_inc_t > 0) call post_data(CS%id_inc_t, T_inc, CS%diag_CS) + if (CS%id_inc_s > 0) call post_data(CS%id_inc_s, S_inc, CS%diag_CS) + call disable_averaging(CS%diag_CS) + + call diag_update_remap_grids(CS%diag_CS) + call cpu_clock_end(id_clock_apply_increments) + end subroutine apply_oda_tracer_increments + subroutine set_up_global_tgrid(T_grid, CS, G) + type(grid_type), pointer :: T_grid !< global tracer grid + type(ODA_CS), pointer, intent(in) :: CS !< A pointer to DA control structure. + type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model + + ! local variables + real, dimension(:,:), allocatable :: global2D, global2D_old + integer :: i, j, k + + ! get global grid information from ocean_model + T_grid=>NULL() + !if (associated(T_grid)) call MOM_error(FATAL,'MOM_oda_driver:set_up_global_tgrid called with associated T_grid') + + allocate(T_grid) + T_grid%ni = CS%ni + T_grid%nj = CS%nj + T_grid%nk = CS%nk + allocate(T_grid%x(CS%ni,CS%nj)) + allocate(T_grid%y(CS%ni,CS%nj)) + allocate(T_grid%bathyT(CS%ni,CS%nj)) + call global_field(CS%mpp_domain, CS%Grid%geolonT, T_grid%x) + call global_field(CS%mpp_domain, CS%Grid%geolatT, T_grid%y) + call global_field(CS%domains(CS%ensemble_id)%mpp_domain, G%bathyT, T_grid%bathyT) + if (CS%use_basin_mask) then + allocate(T_grid%basin_mask(CS%ni,CS%nj)) + call global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) + endif + allocate(T_grid%mask(CS%ni,CS%nj,CS%nk), source=0.0) + allocate(T_grid%z(CS%ni,CS%nj,CS%nk), source=0.0) + allocate(global2D(CS%ni,CS%nj)) + allocate(global2D_old(CS%ni,CS%nj)) + + do k = 1, CS%nk + call global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) + do i=1,CS%ni ; do j=1,CS%nj + if ( global2D(i,j) > 1 ) then + T_grid%mask(i,j,k) = 1.0 + endif + enddo; enddo + if (k == 1) then + T_grid%z(:,:,k) = global2D/2 + else + T_grid%z(:,:,k) = T_grid%z(:,:,k-1) + (global2D + global2D_old)/2 + endif + global2D_old = global2D + enddo + + deallocate(global2D) + deallocate(global2D_old) + end subroutine set_up_global_tgrid + !> \namespace MOM_oda_driver_mod !! !! \section section_ODA The Ocean data assimilation (DA) and Ensemble Framework diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index d3199dcb74..91210a328d 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -31,11 +31,7 @@ module MOM_oda_incupd use MOM_time_manager, only : time_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_verticalGrid, only : get_thickness_units - -use mpp_io_mod, only : mpp_get_axis_length -use mpp_io_mod, only : axistype +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units implicit none ; private @@ -238,8 +234,7 @@ subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, res ! get the vertical grid (h_obs) of the increments CS%nz_data = nz_data - allocate(CS%Ref_h%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) - CS%Ref_h%p(:,:,:) = 0.0 ; + allocate(CS%Ref_h%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data), source=0.0) do j=G%jsc,G%jec; do i=G%isc,G%iec ; do k=1,CS%nz_data CS%Ref_h%p(i,j,k) = data_h(i,j,k) enddo; enddo ; enddo @@ -277,8 +272,7 @@ subroutine set_up_oda_incupd_field(sp_val, G, GV, CS) ! store the increment/full field tracer profiles CS%Inc(CS%fldno)%nz_data = CS%nz_data - allocate(CS%Inc(CS%fldno)%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) - CS%Inc(CS%fldno)%p(:,:,:) = 0.0 + allocate(CS%Inc(CS%fldno)%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data), source=0.0) do k=1,CS%nz_data ; do j=G%jsc,G%jec ; do i=G%isc,G%iec CS%Inc(CS%fldno)%p(i,j,k) = sp_val(i,j,k) enddo ; enddo ; enddo @@ -305,8 +299,7 @@ subroutine set_up_oda_incupd_vel_field(u_val, v_val, G, GV, CS) ! store the increment/full field u profile - allocate(CS%Inc_u%p(G%isdB:G%iedB,G%jsd:G%jed,CS%nz_data)) - CS%Inc_u%p(:,:,:) = 0.0 + allocate(CS%Inc_u%p(G%isdB:G%iedB,G%jsd:G%jed,CS%nz_data), source=0.0) do j=G%jsc,G%jec ; do i=G%iscB,G%iecB do k=1,CS%nz_data CS%Inc_u%p(i,j,k) = u_val(i,j,k) @@ -314,8 +307,7 @@ subroutine set_up_oda_incupd_vel_field(u_val, v_val, G, GV, CS) enddo ; enddo ! store the increment/full field v profile - allocate(CS%Inc_v%p(G%isd:G%ied,G%jsdB:G%jedB,CS%nz_data)) - CS%Inc_v%p(:,:,:) = 0.0 + allocate(CS%Inc_v%p(G%isd:G%ied,G%jsdB:G%jedB,CS%nz_data), source=0.0) do j=G%jscB,G%jecB ; do i=G%isc,G%iec do k=1,CS%nz_data CS%Inc_v%p(i,j,k) = v_val(i,j,k) @@ -376,7 +368,7 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) ! get h_obs nz_data = CS%Inc(1)%nz_data - allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data)) ; h_obs(:,:,:) = 0.0 + allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data), source=0.0) do k=1,nz_data ; do j=js,je ; do i=is,ie h_obs(i,j,k) = CS%Ref_h%p(i,j,k) enddo ; enddo ; enddo @@ -384,10 +376,10 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) ! allocate 1-d arrays - allocate(tmp_h(nz_data)); tmp_h(:) = 0.0 - allocate(tmp_val2(nz_data)) ; tmp_val2(:) = 0.0 - allocate(hu_obs(nz_data)) ; hu_obs(:) = 0.0 - allocate(hv_obs(nz_data)) ; hv_obs(:) = 0.0 + allocate(tmp_h(nz_data), source=0.0) + allocate(tmp_val2(nz_data), source=0.0) + allocate(hu_obs(nz_data), source=0.0) + allocate(hv_obs(nz_data), source=0.0) ! remap t,s (on h_init) to h_obs to get increment tmp_val1(:) = 0.0 @@ -591,17 +583,17 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) ! get h_obs nz_data = CS%Inc(1)%nz_data - allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data)) ; h_obs(:,:,:) = 0.0 + allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data), source=0.0) do k=1,nz_data ; do j=js,je ; do i=is,ie h_obs(i,j,k) = CS%Ref_h%p(i,j,k) enddo ; enddo ; enddo call pass_var(h_obs,G%Domain) ! allocate 1-d array - allocate(tmp_h(nz_data)); tmp_h(:) = 0.0 + allocate(tmp_h(nz_data), source=0.0) allocate(tmp_val2(nz_data)) - allocate(hu_obs(nz_data)) ; hu_obs(:) = 0.0 - allocate(hv_obs(nz_data)) ; hv_obs(:) = 0.0 + allocate(hu_obs(nz_data), source=0.0) + allocate(hv_obs(nz_data), source=0.0) ! add increments to tracers tmp_val1(:) = 0.0 diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 25946eb631..5efb318db1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -81,8 +81,10 @@ module MOM_MEKE real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE [nondim] real :: MEKE_topographic_beta !< Weight for how much topographic beta is considered !! when computing beta in Rhines scale [nondim] - real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its equilibrium value [T-1 ~> s-1]. - + real :: MEKE_restoring_rate !< Inverse of the timescale used to nudge MEKE toward its equilibrium value [s-1]. + logical :: fixed_total_depth !< If true, use the nominal bathymetric depth as the estimate of + !! the time-varying ocean depth. Otherwise base the depth on the total + !! ocean mass per unit area. logical :: kh_flux_enabled !< If true, lateral diffusive MEKE flux is enabled. logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. logical :: debug !< If true, write out checksums of data for debugging @@ -126,12 +128,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real, dimension(SZI_(G),SZJ_(G)) :: & mass, & ! The total mass of the water column [R Z ~> kg m-2]. I_mass, & ! The inverse of mass [R-1 Z-1 ~> m2 kg-1]. + depth_tot, & ! The depth of the water column [Z ~> m]. src, & ! The sum of all MEKE sources [L2 T-3 ~> W kg-1] (= m2 s-3). MEKE_decay, & ! A diagnostic of the MEKE decay timescale [T-1 ~> s-1]. drag_rate_visc, & ! Near-bottom velocity contribution to bottom 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]. @@ -161,7 +162,8 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real :: advFac ! The product of the advection scaling factor and 1/dt [T-1 ~> s-1] real :: mass_neglect ! A negligible mass [R Z ~> kg m-2]. real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. - real :: Rho0 ! A density used to convert mass to distance [R ~> kg m-3]. + real :: Rho0 ! A density used to convert mass to distance [R ~> kg m-3] + real :: I_Rho0 ! The inverse of the density used to convert mass to distance [R-1 ~> m3 kg-1] real :: sdt ! dt to use locally [T ~> s] (could be scaled to accelerate) real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite @@ -175,8 +177,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.") - if ((CS%MEKE_damping > 0.0) .or. (CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) & - .or. CS%visc_drag) then + if ((CS%MEKE_Cd_scale > 0.0) .or. (CS%MEKE_Cb>0.) .or. CS%visc_drag) then use_drag_rate = .true. else use_drag_rate = .false. @@ -204,6 +205,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping Rho0 = GV%Rho0 + I_Rho0 = 1.0 / GV%Rho0 mass_neglect = GV%H_to_RZ * GV%H_subroundoff cdrag2 = CS%cdrag**2 @@ -231,12 +233,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo endif - 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_J15(i,j) = 0. - enddo ; enddo - endif ! Calculate drag_rate_visc(i,j) which accounts for the model bottom mean flow if (CS%visc_drag) then @@ -280,13 +276,25 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo enddo + if (CS%fixed_total_depth) then + !$OMP parallel do default(shared) + do j=js-1,je+1 ; do i=is-1,ie+1 + depth_tot(i,j) = G%bathyT(i,j) + G%Z_ref + enddo ; enddo + else + !$OMP parallel do default(shared) + do j=js-1,je+1 ; do i=is-1,ie+1 + depth_tot(i,j) = mass(i,j) * I_Rho0 + enddo ; enddo + endif + if (CS%initialize) then - call MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass) + call MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass, depth_tot) CS%initialize = .false. endif ! Calculates bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, bottomFac2, barotrFac2, LmixScale) + call MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, MEKE%MEKE, depth_tot, bottomFac2, barotrFac2, LmixScale) if (CS%debug) then if (CS%visc_drag) & call uvchksum("MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, G%HI, & @@ -323,7 +331,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_GMcoeff*MEKE%GM_src(i,j) / & - (GV%Rho0 * MAX(1.0*US%m_to_Z, G%bathyT(i,j))) + (GV%Rho0 * MAX(1.0*US%m_to_Z, depth_tot(i,j))) enddo ; enddo else !$OMP parallel do default(shared) @@ -334,7 +342,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif if (CS%MEKE_equilibrium_restoring) then - call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v) + call MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) do j=js,je ; do i=is,ie src(i,j) = src(i,j) - CS%MEKE_restoring_rate*(MEKE%MEKE(i,j) - CS%equilibrium_value(i,j)) enddo ; enddo @@ -357,6 +365,11 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h drag_rate(i,j) = (US%L_to_Z*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 + else + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + drag_rate(i,j) = 0. + enddo ; enddo endif ! First stage of Strang splitting @@ -525,16 +538,16 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h drag_rate(i,j) = (US%L_to_Z*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. - ! 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 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. + ! 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 endif ! MEKE_KH>=0 @@ -542,10 +555,6 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call hchksum(MEKE%MEKE, "MEKE post-update MEKE", G%HI, haloshift=0, scale=US%L_T_to_m_s**2) endif - ! do j=js,je ; do i=is,ie - ! MEKE%MEKE(i,j) = MAX(MEKE%MEKE(i,j),0.0) - ! enddo ; enddo - 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) @@ -645,10 +654,10 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h end subroutine step_forward_MEKE -!> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity +!> Calculates the equilibrium solution where the source depends only on MEKE diffusivity !! and there is no lateral diffusion of MEKE. !! Results is in MEKE%MEKE. -subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass) +subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass, depth_tot) type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -659,6 +668,8 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m 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 [R-1 Z-1 ~> m2 kg-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. + ! Local variables 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] @@ -675,6 +686,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m real :: resid, ResMin, ResMax ! Residuals [L2 T-3 ~> W kg-1] real :: FatH ! Coriolis parameter at h points; to compute topographic beta [T-1 ~> s-1] real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] + real :: dZ_neglect ! A negligible change in height [Z ~> m] integer :: i, j, is, ie, js, je, n1, n2 real :: tolerance ! Width of EKE bracket [L2 T-2 ~> m2 s-2]. logical :: useSecant, debugIteration @@ -688,6 +700,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m Ubg2 = CS%MEKE_Uscale**2 cd2 = CS%cdrag**2 tolerance = 1.0e-12*US%m_s_to_L_T**2 + dZ_neglect = GV%H_to_Z*GV%H_subroundoff !$OMP do do j=js,je ; do i=is,ie @@ -696,27 +709,26 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) if (CS%MEKE_equilibrium_alt) then - MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*G%bathyT(i,j))**2 / cd2 + MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_m*depth_tot(i,j))**2 / cd2 else FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + & (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points ! Since zero-bathymetry cells are masked, this avoids calculations on land - if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.) then + if (CS%MEKE_topographic_beta == 0. .or. (depth_tot(i,j) == 0.0)) then beta_topo_x = 0. ; beta_topo_y = 0. else - !### Consider different combinations of these estimates of topographic beta, and the use - ! of the water column thickness instead of the bathymetric depth. + !### Consider different combinations of these estimates of topographic beta. 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) & - + (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) ) + (depth_tot(i+1,j)-depth_tot(i,j)) * G%IdxCu(I,j) & + / max(depth_tot(i+1,j), depth_tot(i,j), dZ_neglect) & + + (depth_tot(i,j)-depth_tot(i-1,j)) * G%IdxCu(I-1,j) & + / max(depth_tot(i,j), depth_tot(i-1,j), dZ_neglect) ) 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) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdyCv(i,J-1) & - / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + (depth_tot(i,j+1)-depth_tot(i,j)) * G%IdyCv(i,J) & + / max(depth_tot(i,j+1), depth_tot(i,j), dZ_neglect) + & + (depth_tot(i,j)-depth_tot(i,j-1)) * G%IdyCv(i,J-1) & + / max(depth_tot(i,j), depth_tot(i,j-1), dZ_neglect) ) endif beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + & (G%dF_dy(i,j) + beta_topo_y)**2 ) @@ -735,7 +747,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m do while (resid>0.) n1 = n1 + 1 EKE = EKEmax - call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, depth_tot(i,j), & MEKE%Rd_dx_h(i,j), SN, EKE, & bottomFac2, barotrFac2, LmixScale, LRhines, LEady) ! TODO: Should include resolution function in Kh @@ -810,12 +822,14 @@ end subroutine MEKE_equilibrium !< This subroutine calculates a new equilibrium value for MEKE at each time step. This is not copied into !! MEKE%MEKE; rather, it is used as a restoring term to nudge MEKE%MEKE back to an equilibrium value -subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v) +subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot) type(ocean_grid_type), intent(inout) :: G !< Ocean grid. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type. type(MEKE_CS), pointer :: CS !< MEKE control structure. real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. + ! Local variables real :: SN ! The local Eady growth rate [T-1 ~> s-1] integer :: i, j, is, ie, js, je ! local indices @@ -832,7 +846,7 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v) ! SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1)) - CS%equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*G%bathyT(i,j))**2 / cd2 + CS%equilibrium_value(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2 enddo ; enddo if (CS%id_MEKE_equilibrium>0) call post_data(CS%id_MEKE_equilibrium, CS%equilibrium_value, CS%diag) @@ -842,8 +856,8 @@ end subroutine MEKE_equilibrium_restoring !> 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(CS, MEKE, G, GV, US, SN_u, SN_v, & - EKE, bottomFac2, barotrFac2, LmixScale) +subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & + bottomFac2, barotrFac2, LmixScale) type(MEKE_CS), pointer :: CS !< MEKE control structure. type(MEKE_type), pointer :: MEKE !< MEKE data. type(ocean_grid_type), intent(inout) :: G !< Ocean grid. @@ -852,8 +866,9 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: SN_u !< Eady growth rate at u-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJB_(G)), intent(in) :: SN_v !< Eady growth rate at v-points [T-1 ~> s-1]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The depth of the water column [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 [nondim] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 [nondim] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady ! Possible mixing length scales [L ~> m] @@ -861,9 +876,11 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & real :: SN ! The local Eady growth rate [T-1 ~> s-1] real :: FatH ! Coriolis parameter at h points [T-1 ~> s-1] real :: beta_topo_x, beta_topo_y ! Topographic PV gradients in x and y [T-1 L-1 ~> s-1 m-1] + real :: dZ_neglect ! A negligible change in height [Z ~> m] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + dZ_neglect = GV%H_to_Z*GV%H_subroundoff !$OMP do do j=js,je ; do i=is,ie @@ -876,24 +893,23 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & 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 + ! If depth_tot 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. ! Since zero-bathymetry cells are masked, this should not affect values. - if (CS%MEKE_topographic_beta == 0. .or. G%bathyT(i,j) == 0.0) then + if (CS%MEKE_topographic_beta == 0. .or. (depth_tot(i,j) == 0.0)) then beta_topo_x = 0. ; beta_topo_y = 0. else - !### Consider different combinations of these estimates of topographic beta, and the use - ! of the water column thickness instead of the bathymetric depth. + !### Consider different combinations of these estimates of topographic beta. 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) & - + (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) ) + (depth_tot(i+1,j)-depth_tot(i,j)) * G%IdxCu(I,j) & + / max(depth_tot(i+1,j), depth_tot(i,j), dZ_neglect) & + + (depth_tot(i,j)-depth_tot(i-1,j)) * G%IdxCu(I-1,j) & + / max(depth_tot(i,j), depth_tot(i-1,j), dZ_neglect) ) 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) + & - (G%bathyT(i,j)-G%bathyT(i,j-1)) * G%IdyCv(i,J-1) & - / max(G%bathyT(i,j),G%bathyT(i,j-1), GV%H_subroundoff) ) + (depth_tot(i,j+1)-depth_tot(i,j)) * G%IdyCv(i,J) & + / max(depth_tot(i,j+1), depth_tot(i,j), dZ_neglect) + & + (depth_tot(i,j)-depth_tot(i,j-1)) * G%IdyCv(i,J-1) & + / max(depth_tot(i,j), depth_tot(i,j-1), dZ_neglect) ) endif beta = sqrt((G%dF_dx(i,j) + beta_topo_x)**2 + & (G%dF_dy(i,j) + beta_topo_y)**2 ) @@ -902,7 +918,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, & beta = 0. endif ! Returns bottomFac2, barotrFac2 and LmixScale - call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, G%bathyT(i,j), & + call MEKE_lengthScales_0d(CS, US, G%areaT(i,j), beta, depth_tot(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)) @@ -1156,6 +1172,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "If positive, is a fixed length contribution to the expression "//& "for mixing length used in MEKE-derived diffusivity.", & units="m", default=0.0, scale=US%m_to_L) + call get_param(param_file, mdl, "MEKE_FIXED_TOTAL_DEPTH", CS%fixed_total_depth, & + "If true, use the nominal bathymetric depth as the estimate of the "//& + "time-varying ocean depth. Otherwise base the depth on the total ocean mass"//& + "per unit area.", default=.true.) + 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.", & @@ -1387,41 +1408,36 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) ! Allocate memory call MOM_mesg("MEKE_alloc_register_restart: allocating and registering", 5) isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed - allocate(MEKE%MEKE(isd:ied,jsd:jed)) ; MEKE%MEKE(:,:) = 0.0 + allocate(MEKE%MEKE(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE", "m2 s-2", hor_grid='h', z_grid='1', & longname="Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%MEKE, vd, .false., restart_CS) - if (MEKE_GMcoeff>=0.) then - allocate(MEKE%GM_src(isd:ied,jsd:jed)) ; MEKE%GM_src(:,:) = 0.0 - endif - if (MEKE_FrCoeff>=0. .or. MEKE_GMECoeff>=0.) then - allocate(MEKE%mom_src(isd:ied,jsd:jed)) ; MEKE%mom_src(:,:) = 0.0 - endif - if (MEKE_GMECoeff>=0.) then - allocate(MEKE%GME_snk(isd:ied,jsd:jed)) ; MEKE%GME_snk(:,:) = 0.0 - endif + if (MEKE_GMcoeff>=0.) allocate(MEKE%GM_src(isd:ied,jsd:jed), source=0.0) + if (MEKE_FrCoeff>=0. .or. MEKE_GMECoeff>=0.) & + allocate(MEKE%mom_src(isd:ied,jsd:jed), source=0.0) + if (MEKE_GMECoeff>=0.) allocate(MEKE%GME_snk(isd:ied,jsd:jed), source=0.0) if (MEKE_KhCoeff>=0.) then - allocate(MEKE%Kh(isd:ied,jsd:jed)) ; MEKE%Kh(:,:) = 0.0 + allocate(MEKE%Kh(isd:ied,jsd:jed), source=0.0) 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 - allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 + allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed), source=0.0) if (MEKE_viscCoeff_Ku/=0.) then - allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 + allocate(MEKE%Ku(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Ku", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Ku, vd, .false., restart_CS) endif if (Use_Kh_in_MEKE) then - allocate(MEKE%Kh_diff(isd:ied,jsd:jed)) ; MEKE%Kh_diff(:,:) = 0.0 + allocate(MEKE%Kh_diff(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Kh_diff", "m2 s-1",hor_grid='h',z_grid='1', & longname="Copy of thickness diffusivity for diffusing MEKE") call register_restart_field(MEKE%Kh_diff, vd, .false., restart_CS) endif if (MEKE_viscCoeff_Au/=0.) then - allocate(MEKE%Au(isd:ied,jsd:jed)) ; MEKE%Au(:,:) = 0.0 + allocate(MEKE%Au(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Au", "m4 s-1", hor_grid='h', z_grid='1', & longname="Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Au, vd, .false., restart_CS) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index c588a1faa4..7a3e56ef63 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -190,6 +190,7 @@ module MOM_hor_visc integer :: id_h_diffu = -1, id_h_diffv = -1 integer :: id_hf_diffu_2d = -1, id_hf_diffv_2d = -1 integer :: id_intz_diffu_2d = -1, id_intz_diffv_2d = -1 + integer :: id_diffu_visc_rem = -1, id_diffv_visc_rem = -1 integer :: id_Ah_h = -1, id_Ah_q = -1 integer :: id_Kh_h = -1, id_Kh_q = -1 integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 @@ -276,10 +277,14 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grad_vel_mag_h, & ! Magnitude of the velocity gradient tensor squared at h-points [T-2 ~> s-2] grad_vel_mag_bt_h, & ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] grad_d2vel_mag_h, & ! Magnitude of the Laplacian of the velocity vector, squared [L-2 T-2 ~> m-2 s-2] + GME_effic_h, & ! The filtered efficiency of the GME terms at h points [nondim] + htot, & ! The total thickness of all layers [Z ~> m] boundary_mask_h ! A mask that zeroes out cells with at least one land edge [nondim] real, allocatable, dimension(:,:,:) :: h_diffu ! h x diffu [H L T-2 ~> m2 s-2] real, allocatable, dimension(:,:,:) :: h_diffv ! h x diffv [H L T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: diffu_visc_rem ! diffu x visc_rem_u [L T-2 ~> m s-2] + real, allocatable, dimension(:,:,:) :: diffv_visc_rem ! diffv x visc_rem_v [L T-2 ~> m s-2] real, dimension(SZIB_(G),SZJB_(G)) :: & dvdx, dudy, & ! components in the shearing strain [T-1 ~> s-1] @@ -301,6 +306,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, hq, & ! harmonic mean of the harmonic means of the u- & v point thicknesses [H ~> m or kg m-2] ! This form guarantees that hq/hu < 4. grad_vel_mag_bt_q, & ! Magnitude of the barotropic velocity gradient tensor squared at q-points [T-2 ~> s-2] + GME_effic_q, & ! The filtered efficiency of the GME terms at q points [nondim] boundary_mask_q ! A mask that zeroes out cells with at least one land edge [nondim] real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & @@ -338,6 +344,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity ! points where masks are applied [H ~> m or kg m-2]. + real :: h_arith_q ! The arithmetic mean total thickness at q points [Z ~> m] + real :: h_harm_q ! The harmonic mean total thickness at q points [Z ~> m] + real :: I_hq ! The inverse of the arithmetic mean total thickness at q points [Z-1 ~> m-1] + real :: I_GME_h0 ! The inverse of GME tapering scale [Z-1 ~> m-1] real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2] real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6] real :: h_min ! Minimum h at the 4 neighboring velocity points [H ~> m] @@ -496,11 +506,40 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vel_mag_bt_q(I,J) = boundary_mask_q(I,J) * (dvdx_bt(i,j)**2 + dudy_bt(i,j)**2 + & + grad_vel_mag_bt_q(I,J) = boundary_mask_q(I,J) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & (0.25*((dudx_bt(i,j)+dudx_bt(i+1,j+1))+(dudx_bt(i,j+1)+dudx_bt(i+1,j))))**2 + & (0.25*((dvdy_bt(i,j)+dvdy_bt(i+1,j+1))+(dvdy_bt(i,j+1)+dvdy_bt(i+1,j))))**2) enddo ; enddo + do j=js-1,je+1 ; do i=is-1,ie+1 + htot(i,j) = 0.0 + enddo ; enddo + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + htot(i,j) = htot(i,j) + GV%H_to_Z*h(i,j,k) + enddo ; enddo ; enddo + + I_GME_h0 = 1.0 / CS%GME_h0 + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + if (grad_vel_mag_bt_h(i,j)>0) then + GME_effic_h(i,j) = CS%GME_efficiency * boundary_mask_h(i,j) * & + (MIN(htot(i,j) * I_GME_h0, 1.0)**2) + else + GME_effic_h(i,j) = 0.0 + endif + enddo ; enddo + + do J=js-1,Jeq ; do I=is-1,Ieq + if (grad_vel_mag_bt_q(I,J)>0) then + h_arith_q = 0.25 * ((htot(i,j) + htot(i+1,j+1)) + (htot(i+1,j) + htot(i,j+1))) + I_hq = 1.0 / h_arith_q + h_harm_q = 0.25 * h_arith_q * ((htot(i,j)*I_hq + htot(i+1,j+1)*I_hq) + & + (htot(i+1,j)*I_hq + htot(i,j+1)*I_hq)) + GME_effic_q(I,J) = CS%GME_efficiency * boundary_mask_q(I,J) * (MIN(h_harm_q * I_GME_h0, 1.0)**2) + else + GME_effic_q(I,J) = 0.0 + endif + enddo ; enddo + endif ! use_GME !$OMP parallel do default(none) & @@ -509,7 +548,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, & !$OMP apply_OBC, rescale_Kh, legacy_bound, find_FrictWork, & !$OMP use_MEKE_Ku, use_MEKE_Au, boundary_mask_h, boundary_mask_q, & - !$OMP backscat_subround, GME_coeff_limiter, & + !$OMP backscat_subround, GME_coeff_limiter, GME_effic_h, GME_effic_q, & !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI6, H0_GME, & !$OMP diffu, diffv, Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & !$OMP div_xx_h, sh_xx_h, vort_xy_q, sh_xy_q, GME_coeff_h, GME_coeff_q, & @@ -1388,15 +1427,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call pass_vector(KH_u_GME, KH_v_GME, G%Domain) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - if (grad_vel_mag_bt_h(i,j)>0) then - GME_coeff = CS%GME_efficiency * (MIN(G%bathyT(i,j)/CS%GME_h0,1.0)**2) * & - (0.25*(KH_u_GME(I,j,k)+KH_u_GME(I-1,j,k)+KH_v_GME(i,J,k)+KH_v_GME(i,J-1,k))) - else - GME_coeff = 0.0 - endif - - ! apply mask - GME_coeff = GME_coeff * boundary_mask_h(i,j) + GME_coeff = GME_effic_h(i,j) * 0.25 * & + ((KH_u_GME(I,j,k)+KH_u_GME(I-1,j,k)) + (KH_v_GME(i,J,k)+KH_v_GME(i,J-1,k))) GME_coeff = MIN(GME_coeff, CS%GME_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff @@ -1405,15 +1437,8 @@ 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) then - GME_coeff = CS%GME_efficiency * (MIN(G%bathyT(i,j)/CS%GME_h0,1.0)**2) * & - (0.25*(KH_u_GME(I,j,k)+KH_u_GME(I,j+1,k)+KH_v_GME(i,J,k)+KH_v_GME(i+1,J,k))) - else - GME_coeff = 0.0 - endif - - ! apply mask - GME_coeff = GME_coeff * boundary_mask_q(I,J) + GME_coeff = GME_effic_q(I,J) * 0.25 * & + ((KH_u_GME(I,j,k)+KH_u_GME(I,j+1,k)) + (KH_v_GME(i,J,k)+KH_v_GME(i+1,J,k))) GME_coeff = MIN(GME_coeff, CS%GME_limiter) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff @@ -1422,8 +1447,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo ! 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) + call smooth_GME(CS, G, GME_flux_h=str_xx_GME) + call smooth_GME(CS, G, GME_flux_q=str_xy_GME) do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) @@ -1444,7 +1469,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, enddo ; enddo endif - else ! use_GME + else ! .not. use_GME do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo @@ -1686,8 +1711,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (present(ADp) .and. (CS%id_h_diffu > 0)) then - allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_diffu(:,:,:) = 0.0 + allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -1695,8 +1719,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, deallocate(h_diffu) endif if (present(ADp) .and. (CS%id_h_diffv > 0)) then - allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_diffv(:,:,:) = 0.0 + allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1704,6 +1727,23 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, deallocate(h_diffv) endif + if (present(ADp) .and. (CS%id_diffu_visc_rem > 0)) then + allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + diffu_visc_rem(I,j,k) = diffu(I,j,k) * ADp%visc_rem_u(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_diffu_visc_rem, diffu_visc_rem, CS%diag) + deallocate(diffu_visc_rem) + endif + if (present(ADp) .and. (CS%id_diffv_visc_rem > 0)) then + allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + diffv_visc_rem(i,J,k) = diffv(i,J,k) * ADp%visc_rem_v(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_diffv_visc_rem, diffv_visc_rem, CS%diag) + deallocate(diffv_visc_rem) + endif + end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity(). @@ -2448,6 +2488,20 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, MEKE, ADp) call safe_alloc_ptr(ADp%diag_hv,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) endif + CS%id_diffu_visc_rem = register_diag_field('ocean_model', 'diffu_visc_rem', diag%axesCuL, Time, & + 'Zonal Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if ((CS%id_diffu_visc_rem > 0) .and. (present(ADp))) then + call safe_alloc_ptr(ADp%visc_rem_u,G%IsdB,G%IedB,G%jsd,G%jed,GV%ke) + endif + + CS%id_diffv_visc_rem = register_diag_field('ocean_model', 'diffv_visc_rem', diag%axesCvL, Time, & + 'Meridional Acceleration from Horizontal Viscosity multiplied by viscous remnant', 'm s-2', & + conversion=US%L_T2_to_m_s2) + if ((CS%id_diffv_visc_rem > 0) .and. (present(ADp))) then + call safe_alloc_ptr(ADp%visc_rem_v,G%isd,G%ied,G%JsdB,G%JedB,GV%ke) + endif + 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', conversion=US%L_to_m**4*US%s_to_T, & diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 8c08691675..54370611ad 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -96,6 +96,9 @@ module MOM_internal_tides real :: decay_rate !< A constant rate at which internal tide energy is !! lost to the interior ocean internal wave field. real :: cdrag !< The bottom drag coefficient [nondim]. + real :: drag_min_depth !< The minimum total ocean thickness that will be used in the denominator + !! of the quadratic drag terms for internal tides when + !! INTERNAL_TIDE_QUAD_DRAG is true [Z ~> m] logical :: apply_background_drag !< If true, apply a drag due to background processes as a sink. logical :: apply_bottom_drag @@ -185,6 +188,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & tot_En, & ! energy summed over angles, modes, frequencies [R Z3 T-2 ~> J m-2] tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_allprocesses_loss, & ! energy loss rates summed over angle, freq, and mode [R Z3 T-3 ~> W m-2] + htot, & ! The vertical sum of the layer thicknesses [H ~> m or kg m-2] drag_scale, & ! bottom drag scale [T-1 ~> s-1] itidal_loss_mode, allprocesses_loss_mode ! energy loss rates for a given mode and frequency (summed over angles) [R Z3 T-3 ~> W m-2] @@ -200,7 +204,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real :: En_initial, Delta_E_check ! Energies for debugging [R Z3 T-2 ~> J m-2] real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [R Z3 T-3 ~> W m-2] character(len=160) :: mesg ! The text of an error message - integer :: a, m, fr, i, j, is, ie, js, je, isd, ied, jsd, jed, nAngle, nzm + integer :: a, m, fr, i, j, k, is, ie, js, je, isd, ied, jsd, jed, nAngle, nzm integer :: id_g, jd_g ! global (decomp-invar) indices (for debugging) type(group_pass_type), save :: pass_test, pass_En type(time_type) :: time_end @@ -212,6 +216,10 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & I_rho0 = 1.0 / GV%Rho0 cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. + ! init local arrays + drag_scale(:,:) = 0. + Ub(:,:,:,:) = 0. + ! Set the wave speeds for the modes, using cg(n) ~ cg(1)/n.********************** ! This is wrong, of course, but it works reasonably in some cases. ! Uncomment if wave_speed is not used to calculate the true values (BDM). @@ -360,9 +368,12 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Extract the energy for mixing due to bottom drag------------------------------- if (CS%apply_bottom_drag) then + do j=jsd,jed ; do i=isd,ied ; htot(i,j) = 0.0 ; enddo ; enddo + do k=1,GV%ke ; do j=jsd,jed ; do i=isd,ied + htot(i,j) = htot(i,j) + h(i,j,k) + enddo ; enddo ; enddo do j=jsd,jed ; do i=isd,ied - ! Note the 1 m dimensional scale here. Should this be a parameter? - I_D_here = 1.0 / (max(G%bathyT(i,j), 1.0*US%m_to_Z)) + I_D_here = 1.0 / (max(GV%H_to_Z*htot(i,j), CS%drag_min_depth)) drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*vel_btTide(i,j)**2 + & tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here enddo ; enddo @@ -777,6 +788,9 @@ 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, dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: cn_u !< Internal wave group velocity at U-point + real, dimension(G%isd:G%ied,G%JsdB:G%JedB) :: cn_v !< Internal wave group velocity at V-point + real, dimension(G%isd:G%ied,G%jsd:G%jed) :: cnmask !< Local mask for group velocity 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]. @@ -787,12 +801,29 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) 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 + real :: wgt1, wgt2 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; na = size(En,3) asd = 1-stencil ; aed = NAngle+stencil + cnmask(:,:) = merge(0., 1., cn(:,:) == 0.) + + do j=js,je ; do i=is-1,ie + ! wgt = 0 if local cn == 0, wgt = 0.5 if both contiguous values != 0 + ! and wgt = 1 if neighbour cn == 0 + wgt1 = cnmask(i,j) - 0.5 * cnmask(i,j) * cnmask(i+1,j) + wgt2 = cnmask(i+1,j) - 0.5 * cnmask(i,j) * cnmask(i+1,j) + cn_u(I,j) = wgt1*cn(i,j) + wgt2*cn(i+1,j) + enddo ; enddo + + do j=js-1,je ; do i=is,ie + wgt1 = cnmask(i,j) - 0.5 * cnmask(i,j) * cnmask(i,j+1) + wgt2 = cnmask(i,j+1) - 0.5 * cnmask(i,j) * cnmask(i,j+1) + cn_v(i,J) = wgt1*cn(i,j) + wgt2*cn(i,j+1) + enddo ; enddo + Ifreq = 1.0 / freq - cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. + cn_subRO = 1e-30*US%m_s_to_L_T Angle_size = (8.0*atan(1.0)) / (real(NAngle)) dt_Angle_size = dt / Angle_size @@ -821,16 +852,12 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) (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) ) 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)) / & - (0.5*(cn(i,j) + cn(i,j-1)) + cn_subRO) ) + + dlnCn_dx = G%IdxT(i,j) * (cn_u(I,j) - cn_u(I-1,j)) / (0.5 * (cn_u(I,j) + cn_u(I-1,j)) + cn_subRO) + dlnCn_dy = G%IdyT(i,j) * (cn_v(i,J) - cn_v(i,J-1)) / (0.5 * (cn_v(i,J) + cn_v(i,J-1)) + cn_subRO) + Kmag2 = (freq**2 - f2) / (cn(i,j)**2 + cn_subRO**2) if (Kmag2 > 0.0) then I_Kmag = 1.0 / sqrt(Kmag2) @@ -1625,33 +1652,29 @@ subroutine reflect(En, NAngle, CS, G, LB) ! values should collocate with angle_c [nondim] logical, dimension(G%isd:G%ied,G%jsd:G%jed) :: ridge ! tags of cells with double reflection + real, dimension(1:Nangle) :: En_reflected ! Energy reflected [R Z3 T-2 ~> J m-2]. real :: TwoPi ! 2*pi = 6.2831853... [nondim] real :: Angle_size ! size of beam wedge [rad] - real :: angle_wall ! angle of coast/ridge/shelf wrt equator [rad] - real, dimension(1:NAngle) :: angle_i ! angle of incident ray wrt equator [rad] - real :: angle_r ! angle of reflected ray wrt equator [rad] - real, dimension(1:Nangle) :: En_reflected - integer :: i, j, a, a_r, na - !integer :: isd, ied, jsd, jed ! start and end local indices on data domain - ! ! (values include halos) + integer :: angle_wall ! angle of coast/ridge/shelf wrt equator [nondim] + integer :: angle_wall0 ! angle of coast/ridge/shelf wrt equator [nondim] + integer :: angle_r ! angle of reflected ray wrt equator [nondim] + integer :: angle_r0 ! angle of reflected ray wrt equator [nondim] + integer :: angle_to_wall ! angle relative to wall [nondim] + integer :: a, a0 ! loop index for angles + integer :: i, j, i_global + integer :: Nangle_d2 ! Nangle / 2 integer :: isc, iec, jsc, jec ! start and end local indices on PE ! (values exclude halos) integer :: ish, ieh, jsh, jeh ! start and end local indices on data domain ! leaving out outdated halo points (march in) - !isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh TwoPi = 8.0*atan(1.0) Angle_size = TwoPi / (real(NAngle)) - - do a=1,NAngle - ! These are the angles at the cell centers - ! (should do this elsewhere since doesn't change with time) - angle_i(a) = Angle_size * real(a - 1) ! for a=1 aligned with x-axis - enddo + Nangle_d2 = (Nangle / 2) ! init local arrays angle_c(:,:) = CS%nullangle @@ -1659,7 +1682,9 @@ subroutine reflect(En, NAngle, CS, G, LB) ridge(:,:) = .false. do j=jsh,jeh ; do i=ish,ieh - angle_c(i,j) = CS%refl_angle(i,j) + if (CS%refl_angle(i,j) /= CS%nullangle) then + angle_c(i,j) = mod(CS%refl_angle(i,j) + TwoPi, TwoPi) + endif part_refl(i,j) = CS%refl_pref(i,j) ridge(i,j) = CS%refl_dbl(i,j) enddo ; enddo @@ -1669,42 +1694,36 @@ subroutine reflect(En, NAngle, CS, G, LB) ! redistribute energy in angular space if ray will hit boundary ! i.e., if energy is in a reflecting cell if (angle_c(i,j) /= CS%nullangle) then + ! refection angle is given in rad, convert to the discrete angle + angle_wall = nint(angle_c(i,j)/Angle_size) + 1 do a=1,NAngle ; if (En(i,j,a) > 0.0) then - if (sin(angle_i(a) - angle_c(i,j)) >= 0.0) then - ! if ray is incident, keep specified boundary angle - angle_wall = angle_c(i,j) - elseif (ridge(i,j)) then - ! if ray is not incident but in ridge cell, use complementary angle - angle_wall = angle_c(i,j) + 0.5*TwoPi - if (angle_wall > TwoPi) then - angle_wall = angle_wall - TwoPi*floor(abs(angle_wall)/TwoPi) - elseif (angle_wall < 0.0) then - angle_wall = angle_wall + TwoPi*ceiling(abs(angle_wall)/TwoPi) + ! reindex to 0 -> Nangle-1 for trig + a0 = a - 1 + angle_wall0 = angle_wall - 1 + ! compute relative angle from wall and use cyclic properties + ! to ensure it is bounded by 0 -> Nangle-1 + angle_to_wall = mod(a0 - angle_wall0 + Nangle, Nangle) + + if (ridge(i,j)) then + ! if ray is not incident but in ridge cell, use complementary angle + if ((Nangle_d2 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle)) then + angle_wall0 = mod(angle_wall0 + Nangle_d2 + Nangle, Nangle) endif - else - ! if ray is not incident and not in a ridge cell, keep specified angle - angle_wall = angle_c(i,j) endif ! do reflection - if (sin(angle_i(a) - angle_wall) >= 0.0) then - angle_r = 2.0*angle_wall - angle_i(a) - if (angle_r > TwoPi) then - angle_r = angle_r - TwoPi*floor(abs(angle_r)/TwoPi) - elseif (angle_r < 0.0) then - angle_r = angle_r + TwoPi*ceiling(abs(angle_r)/TwoPi) - endif - a_r = nint(angle_r/Angle_size) + 1 - do while (a_r > Nangle) ; a_r = a_r - Nangle ; enddo - if (a /= a_r) then - En_reflected(a_r) = part_refl(i,j)*En(i,j,a) - En(i,j,a) = (1.0-part_refl(i,j))*En(i,j,a) + if ((0 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle_d2)) then + angle_r0 = mod(2*angle_wall0 - a0 + Nangle, Nangle) + angle_r = angle_r0 + 1 !re-index to 1 -> Nangle + if (a /= angle_r) then + En_reflected(angle_r) = part_refl(i,j)*En(i,j,a) + En(i,j,a) = (1.0-part_refl(i,j))*En(i,j,a) endif endif endif ; enddo ! a-loop do a=1,NAngle En(i,j,a) = En(i,j,a) + En_reflected(a) - En_reflected(a) = 0.0 + En_reflected(a) = 0.0 ! reset values enddo ! a-loop endif enddo ; enddo ! i- and j-loops @@ -2102,8 +2121,7 @@ end subroutine PPM_limit_pos ! num_angle = 24 ! call read_param(param_file, "INTERNAL_TIDE_ANGLES", num_angle) -! allocate(CS%En_restart(isd:ied, jsd:jed, num_angle)) -! CS%En_restart(:,:,:) = 0.0 +! allocate(CS%En_restart(isd:ied, jsd:jed, num_angle), source=0.0) ! vd = vardesc("En_restart", & ! "The internal wave energy density as a function of (i,j,angle,frequency,mode)", & @@ -2127,20 +2145,20 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Local variables real :: Angle_size ! size of wedges, rad real, allocatable :: angles(:) ! orientations of wedge centers, rad - real, allocatable, dimension(:,:) :: h2 ! topographic roughness scale, m^2 - real :: kappa_itides, kappa_h2_factor - ! characteristic topographic wave number - ! and a scaling factor - real, allocatable :: ridge_temp(:,:) - ! array for temporary storage of flags + real, dimension(:,:), allocatable :: h2 ! topographic roughness scale squared [Z2 ~> m2] + real :: kappa_itides ! characteristic topographic wave number [L-1 ~> m-1] + real, dimension(:,:), allocatable :: ridge_temp ! array for temporary storage of flags ! of cells with double-reflecting ridges - logical :: use_int_tides, use_temperature - real :: period_1 ! The period of the gravest modeled mode [T ~> s] + logical :: use_int_tides, use_temperature + real :: kappa_h2_factor ! A roughness scaling factor [nondim] + real :: RMS_roughness_frac ! The maximum RMS topographic roughness as a fraction of the + ! nominal ocean depth, or a negative value for no limit [nondim] + real :: period_1 ! The period of the gravest modeled mode [T ~> s] 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". -#include "version_variable.h" +# include "version_variable.h" character(len=40) :: mdl = "MOM_internal_tides" ! This module's name. character(len=16), dimension(8) :: freq_name character(len=40) :: var_name @@ -2181,16 +2199,17 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%nFreq = num_freq ; CS%nAngle = num_angle ; CS%nMode = num_mode ! Allocate energy density array - allocate(CS%En(isd:ied, jsd:jed, num_angle, num_freq, num_mode)) - CS%En(:,:,:,:,:) = 0.0 + allocate(CS%En(isd:ied, jsd:jed, num_angle, num_freq, num_mode), source=0.0) ! Allocate phase speed array - allocate(CS%cp(isd:ied, jsd:jed, num_freq, num_mode)) - CS%cp(:,:,:,:) = 0.0 + allocate(CS%cp(isd:ied, jsd:jed, num_freq, num_mode), source=0.0) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) - call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, units="s", scale=US%s_to_T) + call get_param(param_file, mdl, "FIRST_MODE_PERIOD", period_1, & + "The period of the first mode for internal tides", default=44567., & + units="s", scale=US%s_to_T) + do fr=1,num_freq CS%frequency(fr) = (8.0*atan(1.0) * (real(fr)) / period_1) ! ADDED BDM enddo @@ -2264,16 +2283,20 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "1st-order upwind advection. This scheme is highly "//& "continuity solver. This scheme is highly "//& "diffusive but may be useful for debugging.", default=.false.) - call get_param(param_file, mdl, "INTERNAL_TIDE_BACKGROUND_DRAG", & - CS%apply_background_drag, "If true, the internal tide "//& - "ray-tracing advection uses a background drag term as a sink.",& - default=.false.) + call get_param(param_file, mdl, "INTERNAL_TIDE_BACKGROUND_DRAG", CS%apply_background_drag, & + "If true, the internal tide ray-tracing advection uses a background drag "//& + "term as a sink.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_QUAD_DRAG", CS%apply_bottom_drag, & "If true, the internal tide ray-tracing advection uses "//& "a quadratic bottom drag term as a sink.", default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_WAVE_DRAG", CS%apply_wave_drag, & "If true, apply scattering due to small-scale roughness as a sink.", & default=.false.) + call get_param(param_file, mdl, "INTERNAL_TIDE_DRAG_MIN_DEPTH", CS%drag_min_depth, & + "The minimum total ocean thickness that will be used in the denominator "//& + "of the quadratic drag terms for internal tides.", & + units="m", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%apply_bottom_drag) + CS%drag_min_depth = MAX(CS%drag_min_depth, GV%H_subroundoff * GV%H_to_Z) call get_param(param_file, mdl, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, & "If true, apply wave breaking as a sink.", & default=.false.) @@ -2297,25 +2320,20 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & 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"//& + "A scaling factor for the roughness amplitude with "//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) ! Allocate various arrays needed for loss rates - allocate(h2(isd:ied,jsd:jed)) ; h2(:,:) = 0.0 - allocate(CS%TKE_itidal_loss_fixed(isd:ied,jsd:jed)) - CS%TKE_itidal_loss_fixed = 0.0 - allocate(CS%TKE_leak_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_leak_loss(:,:,:,:,:) = 0.0 - allocate(CS%TKE_quad_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_quad_loss(:,:,:,:,:) = 0.0 - allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_itidal_loss(:,:,:,:,:) = 0.0 - allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_Froude_loss(:,:,:,:,:) = 0.0 - allocate(CS%tot_leak_loss(isd:ied,jsd:jed)) ; CS%tot_leak_loss(:,:) = 0.0 - allocate(CS%tot_quad_loss(isd:ied,jsd:jed) ) ; CS%tot_quad_loss(:,:) = 0.0 - allocate(CS%tot_itidal_loss(isd:ied,jsd:jed)) ; CS%tot_itidal_loss(:,:) = 0.0 - allocate(CS%tot_Froude_loss(isd:ied,jsd:jed)) ; CS%tot_Froude_loss(:,:) = 0.0 + allocate(h2(isd:ied,jsd:jed), source=0.0) + allocate(CS%TKE_itidal_loss_fixed(isd:ied,jsd:jed), source=0.0) + allocate(CS%TKE_leak_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_quad_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_Froude_loss(isd:ied,jsd:jed), source=0.0) ! Compute the fixed part of the bottom drag loss from baroclinic modes call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -2324,10 +2342,18 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', h2, G%domain, scale=US%m_to_Z) + call get_param(param_file, mdl, "INTERNAL_TIDE_ROUGHNESS_FRAC", RMS_roughness_frac, & + "The maximum RMS topographic roughness as a fraction of the nominal ocean depth, "//& + "or a negative value for no limit.", units="nondim", default=0.1) + + call MOM_read_data(filename, 'h2', h2, G%domain, scale=US%m_to_Z**2) do j=G%jsc,G%jec ; do i=G%isc,G%iec - ! Restrict rms topo to 10 percent of column depth. - h2(i,j) = min(0.01*(G%bathyT(i,j))**2, h2(i,j)) + ! Restrict RMS topographic roughness to a fraction (10 percent by default) of the column depth. + if (RMS_roughness_frac >= 0.0) then + h2(i,j) = max(min((RMS_roughness_frac*(G%bathyT(i,j)+G%Z_ref))**2, h2(i,j)), 0.0) + else + h2(i,j) = max(h2(i,j), 0.0) + endif ! Compute the fixed part; units are [R L-2 Z3 ~> kg m-2] here ! will be multiplied by N and the squared near-bottom velocity to get into [R Z3 T-3 ~> W m-2] CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) @@ -2341,7 +2367,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "the coastline/ridge/shelf with respect to the equator.", & fail_if_missing=.false., default='') filename = trim(CS%inputdir) // trim(refl_angle_file) - allocate(CS%refl_angle(isd:ied,jsd:jed)) ; CS%refl_angle(:,:) = CS%nullangle + allocate(CS%refl_angle(isd:ied,jsd:jed), source=CS%nullangle) if (file_exists(filename, G%domain)) then call log_param(param_file, mdl, "INPUTDIR/REFL_ANGLE_FILE", filename) call MOM_read_data(filename, 'refl_angle', CS%refl_angle, G%domain) @@ -2360,7 +2386,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "The path to the file containing the reflection coefficients.", & fail_if_missing=.false., default='') filename = trim(CS%inputdir) // trim(refl_pref_file) - allocate(CS%refl_pref(isd:ied,jsd:jed)) ; CS%refl_pref(:,:) = 1.0 + allocate(CS%refl_pref(isd:ied,jsd:jed), source=1.0) if (file_exists(filename, G%domain)) then call log_param(param_file, mdl, "INPUTDIR/REFL_PREF_FILE", filename) call MOM_read_data(filename, 'refl_pref', CS%refl_pref, G%domain) @@ -2372,7 +2398,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call pass_var(CS%refl_pref,G%domain) ! Tag reflection cells with partial reflection (done here for speed) - allocate(CS%refl_pref_logical(isd:ied,jsd:jed)) ; CS%refl_pref_logical(:,:) = .false. + allocate(CS%refl_pref_logical(isd:ied,jsd:jed), source=.false.) do j=jsd,jed do i=isd,ied ! flag cells with partial reflection @@ -2388,7 +2414,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "The path to the file containing the double-reflective ridge tags.", & fail_if_missing=.false., default='') filename = trim(CS%inputdir) // trim(refl_dbl_file) - allocate(ridge_temp(isd:ied,jsd:jed)) ; ridge_temp(:,:) = 0.0 + allocate(ridge_temp(isd:ied,jsd:jed), source=0.0) if (file_exists(filename, G%domain)) then call log_param(param_file, mdl, "INPUTDIR/REFL_DBL_FILE", filename) call MOM_read_data(filename, 'refl_dbl', ridge_temp, G%domain) @@ -2397,7 +2423,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "REFL_DBL_FILE: "//trim(filename)//" not found") endif call pass_var(ridge_temp,G%domain) - allocate(CS%refl_dbl(isd:ied,jsd:jed)) ; CS%refl_dbl(:,:) = .false. + allocate(CS%refl_dbl(isd:ied,jsd:jed), source=.false.) do i=isd,ied ; do j=jsd,jed if (ridge_temp(i,j) == 1) then; CS%refl_dbl(i,j) = .true. else ; CS%refl_dbl(i,j) = .false. ; endif @@ -2484,21 +2510,21 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Time, 'Internal tide energy loss summed over all processes', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) - allocate(CS%id_En_mode(CS%nFreq,CS%nMode)) ; CS%id_En_mode(:,:) = -1 - allocate(CS%id_En_ang_mode(CS%nFreq,CS%nMode)) ; CS%id_En_ang_mode(:,:) = -1 - allocate(CS%id_itidal_loss_mode(CS%nFreq,CS%nMode)) ; CS%id_itidal_loss_mode(:,:) = -1 - allocate(CS%id_allprocesses_loss_mode(CS%nFreq,CS%nMode)) ; CS%id_allprocesses_loss_mode(:,:) = -1 - allocate(CS%id_itidal_loss_ang_mode(CS%nFreq,CS%nMode)) ; CS%id_itidal_loss_ang_mode(:,:) = -1 - allocate(CS%id_Ub_mode(CS%nFreq,CS%nMode)) ; CS%id_Ub_mode(:,:) = -1 - allocate(CS%id_cp_mode(CS%nFreq,CS%nMode)) ; CS%id_cp_mode(:,:) = -1 + allocate(CS%id_En_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_En_ang_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_itidal_loss_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_allprocesses_loss_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_itidal_loss_ang_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_Ub_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_cp_mode(CS%nFreq,CS%nMode), source=-1) - allocate(angles(CS%NAngle)) ; angles(:) = 0.0 + allocate(angles(CS%NAngle), source=0.0) Angle_size = (8.0*atan(1.0)) / (real(num_angle)) do a=1,num_angle ; angles(a) = (real(a) - 1) * Angle_size ; enddo id_ang = diag_axis_init("angle", angles, "Radians", "N", "Angular Orienation of Fluxes") - call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), id_ang /), axes_ang) - + call define_axes_group(diag, (/ diag%axesT1%handles(1), diag%axesT1%handles(2), id_ang /), & + axes_ang, is_h_point=.true.) do fr=1,CS%nFreq ; write(freq_name(fr), '("freq",i1)') fr ; enddo do m=1,CS%nMode ; do fr=1,CS%nFreq ! Register 2-D energy density (summed over angles) for each freq and mode diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index dabeb27159..2d1f7103e6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -184,11 +184,11 @@ subroutine calc_depth_function(G, CS) expo = CS%depth_scaled_khth_exp !$OMP do do j=js,je ; do I=is-1,Ieq - CS%Depth_fn_u(I,j) = (MIN(1.0, 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j))/H0))**expo + CS%Depth_fn_u(I,j) = (MIN(1.0, (0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + G%Z_ref)/H0))**expo enddo ; enddo !$OMP do do J=js-1,Jeq ; do i=is,ie - CS%Depth_fn_v(i,J) = (MIN(1.0, 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1))/H0))**expo + CS%Depth_fn_v(i,J) = (MIN(1.0, (0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + G%Z_ref)/H0))**expo enddo ; enddo end subroutine calc_depth_function @@ -959,11 +959,12 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop enddo ; enddo ! SN above contains S^2*N^2*H, convert to vertical average of S*N do I=is-1,ie - !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(I,j), G%bathyT(I+1,j)) + GV%Angstrom_Z ) )) + !### Replace G%bathT+G%Z_ref here with (e(i,j,1) - e(i,j,nz+1)). + !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(i,j), G%bathyT(i+1,j)) + (G%Z_ref + GV%Angstrom_Z) ) ) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & - (max(G%bathyT(I,j), G%bathyT(I+1,j))) ) + (max(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref) ) else CS%SN_u(I,j) = 0.0 endif @@ -985,20 +986,21 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop 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 ) )) + !### Replace G%bathT+G%Z_ref here with (e(i,j,1) - e(i,j,nz+1)). + !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + (G%Z_ref + GV%Angstrom_Z) ) ) !The code below behaves better than the line above. Not sure why? AJA - if ( min(G%bathyT(I,j), G%bathyT(I+1,j)) > H_cutoff*GV%H_to_Z ) then + if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & - (max(G%bathyT(i,J), G%bathyT(i,J+1))) ) + (max(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref) ) else - CS%SN_v(I,j) = 0.0 + CS%SN_v(i,J) = 0.0 endif if (local_open_v_BC) then - l_seg = OBC%segnum_v(I,j) + l_seg = OBC%segnum_v(i,J) if (l_seg /= OBC_NONE) then - if (OBC%segment(OBC%segnum_v(I,j))%open) then - CS%SN_v(I,j) = 0. + if (OBC%segment(OBC%segnum_v(i,J))%open) then + CS%SN_v(i,J) = 0. endif endif endif @@ -1266,7 +1268,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "The depth below which N2 is monotonized to avoid stratification "//& "artifacts from altering the equivalent barotropic mode structure.",& units="m", default=2000., scale=US%m_to_Z) - allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke)) ; CS%ebt_struct(:,:,:) = 0.0 + allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke), source=0.0) endif if (CS%use_stored_slopes) then @@ -1283,8 +1285,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%use_stored_slopes) then in_use = .true. - allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1)) ; CS%slope_x(:,:,:) = 0.0 - allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1)) ; CS%slope_y(:,:,:) = 0.0 + allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1), source=0.0) + allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1), source=0.0) 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.", & @@ -1293,8 +1295,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_Eady_growth_rate) then in_use = .true. - 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 + allocate(CS%SN_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%SN_v(isd:ied,JsdB:JedB), source=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', conversion=US%s_to_T) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & @@ -1327,8 +1329,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "VISBECK_L_SCALE", CS%Visbeck_L_scale, & "The fixed length scale in the Visbeck formula.", units="m", & default=0.0) - allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = 0.0 - allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 + allocate(CS%L2u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%L2v(isd:ied,JsdB:JedB), source=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) @@ -1384,16 +1386,16 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then CS%calculate_Rd_dx = .true. CS%calculate_res_fns = .true. - allocate(CS%Res_fn_h(isd:ied,jsd:jed)) ; CS%Res_fn_h(:,:) = 0.0 - allocate(CS%Res_fn_q(IsdB:IedB,JsdB:JedB)) ; CS%Res_fn_q(:,:) = 0.0 - allocate(CS%Res_fn_u(IsdB:IedB,jsd:jed)) ; CS%Res_fn_u(:,:) = 0.0 - allocate(CS%Res_fn_v(isd:ied,JsdB:JedB)) ; CS%Res_fn_v(:,:) = 0.0 - allocate(CS%beta_dx2_q(IsdB:IedB,JsdB:JedB)) ; CS%beta_dx2_q(:,:) = 0.0 - allocate(CS%beta_dx2_u(IsdB:IedB,jsd:jed)) ; CS%beta_dx2_u(:,:) = 0.0 - allocate(CS%beta_dx2_v(isd:ied,JsdB:JedB)) ; CS%beta_dx2_v(:,:) = 0.0 - allocate(CS%f2_dx2_q(IsdB:IedB,JsdB:JedB)) ; CS%f2_dx2_q(:,:) = 0.0 - allocate(CS%f2_dx2_u(IsdB:IedB,jsd:jed)) ; CS%f2_dx2_u(:,:) = 0.0 - allocate(CS%f2_dx2_v(isd:ied,JsdB:JedB)) ; CS%f2_dx2_v(:,:) = 0.0 + allocate(CS%Res_fn_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%Res_fn_q(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(CS%Res_fn_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%Res_fn_v(isd:ied,JsdB:JedB), source=0.0) + allocate(CS%beta_dx2_q(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(CS%beta_dx2_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%beta_dx2_v(isd:ied,JsdB:JedB), source=0.0) + allocate(CS%f2_dx2_q(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(CS%f2_dx2_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%f2_dx2_v(isd:ied,JsdB:JedB), source=0.0) CS%id_Res_fn = register_diag_field('ocean_model', 'Res_fn', diag%axesT1, Time, & 'Resolution function for scaling diffusivities', 'nondim') @@ -1481,14 +1483,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%Depth_scaled_KhTh) then CS%calculate_depth_fns = .true. - allocate(CS%Depth_fn_u(IsdB:IedB,jsd:jed)) ; CS%Depth_fn_u(:,:) = 0.0 - allocate(CS%Depth_fn_v(isd:ied,JsdB:JedB)) ; CS%Depth_fn_v(:,:) = 0.0 + allocate(CS%Depth_fn_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%Depth_fn_v(isd:ied,JsdB:JedB), source=0.0) call get_param(param_file, mdl, "DEPTH_SCALED_KHTH_H0", CS%depth_scaled_khth_h0, & - "The depth above which KHTH is scaled away.",& - units="m", scale=US%m_to_Z, default=1000.) + "The depth above which KHTH is scaled away.", & + units="m", scale=US%m_to_Z, default=1000.) call get_param(param_file, mdl, "DEPTH_SCALED_KHTH_EXP", CS%depth_scaled_khth_exp, & - "The exponent used in the depth dependent scaling function for KHTH.",& - units="nondim", default=3.0) + "The exponent used in the depth dependent scaling function for KHTH.", & + units="nondim", default=3.0) endif ! Resolution %Rd_dx_h @@ -1498,9 +1500,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_Rd_dx) then CS%calculate_cg1 = .true. ! We will need %cg1 - allocate(CS%Rd_dx_h(isd:ied,jsd:jed)) ; CS%Rd_dx_h(:,:) = 0.0 - allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 - allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 + allocate(CS%Rd_dx_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%beta_dx2_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%f2_dx2_h(isd:ied,jsd:jed), source=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 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & @@ -1516,7 +1518,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), source=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=.false.) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 9da72d9b2d..0d2062441e 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -971,14 +971,14 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) default=0., do_not_log=.true.) if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then ! CS%MLD_filtered is used to keep a running mean of the PBL's actively mixed MLD. - allocate(CS%MLD_filtered(HI%isd:HI%ied,HI%jsd:HI%jed)) ; CS%MLD_filtered(:,:) = 0. + allocate(CS%MLD_filtered(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) vd = var_desc("MLD_MLE_filtered","m","Time-filtered MLD for use in MLE", & hor_grid='h', z_grid='1') call register_restart_field(CS%MLD_filtered, vd, .false., restart_CS) endif if (CS%MLE_MLD_decay_time2>0.) then ! CS%MLD_filtered_slow is used to keep a running mean of the PBL's seasonal or winter MLD. - allocate(CS%MLD_filtered_slow(HI%isd:HI%ied,HI%jsd:HI%jed)) ; CS%MLD_filtered_slow(:,:) = 0. + allocate(CS%MLD_filtered_slow(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) vd = var_desc("MLD_MLE_filtered_slow","m","c Slower time-filtered MLD for use in MLE", & hor_grid='h', z_grid='1') call register_restart_field(CS%MLD_filtered_slow, vd, .false., restart_CS) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 4d038ed31e..daeb64fab9 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -145,6 +145,8 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp 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 [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G), SZJ_(G)) :: & + htot ! The sum of the total layer thicknesses [H ~> m or kg m-2] real :: Khth_Loc_u(SZIB_(G), SZJ_(G)) real :: Khth_Loc_v(SZI_(G), SZJB_(G)) real :: Khth_Loc(SZIB_(G), SZJB_(G)) ! locally calculated thickness diffusivity [L2 T-1 ~> m2 s-1] @@ -479,33 +481,41 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! thicknesses across u and v faces, converted to 0/1 mask ! layer average of the interface diffusivities KH_u and KH_v do j=js,je ; do I=is-1,ie - hu(I,j) = 2.0*h(i,j,k)*h(i+1,j,k)/(h(i,j,k)+h(i+1,j,k)+h_neglect) - if (hu(I,j) /= 0.0) hu(I,j) = 1.0 + ! This expression uses harmonic mean thicknesses: + ! hu(I,j) = 2.0*h(i,j,k)*h(i+1,j,k) / (h(i,j,k)+h(i+1,j,k)+h_neglect) + ! This expression is a 0/1 mask based on depths where there are thick layers: + hu(I,j) = 0.0 ; if (h(i,j,k)*h(i+1,j,k) /= 0.0) hu(I,j) = 1.0 KH_u_lay(I,j) = 0.5*(KH_u(I,j,k)+KH_u(I,j,k+1)) enddo ; enddo do J=js-1,je ; do i=is,ie - hv(i,J) = 2.0*h(i,j,k)*h(i,j+1,k)/(h(i,j,k)+h(i,j+1,k)+h_neglect) - if (hv(i,J) /= 0.0) hv(i,J) = 1.0 + ! This expression uses harmonic mean thicknesses: + ! hv(i,J) = 2.0*h(i,j,k)*h(i,j+1,k)/(h(i,j,k)+h(i,j+1,k)+h_neglect) + ! This expression is a 0/1 mask based on depths where there are thick layers: + hv(i,J) = 0.0 ; if (h(i,j,k)*h(i,j+1,k) /= 0.0) hv(i,J) = 1.0 KH_v_lay(i,J) = 0.5*(KH_v(i,J,k)+KH_v(i,J,k+1)) enddo ; enddo - ! diagnose diffusivity at T-point + ! diagnose diffusivity at T-points 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)) & - +(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) + 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)) + 1.0e-20) + ! Use this denominator instead if hu and hv are actual thicknesses rather than a 0/1 mask: + ! ((hu(I-1,j)+hu(I,j)) + (hv(i,J-1)+hv(i,J)) + h_neglect) enddo ; enddo enddo if (CS%Use_KH_in_MEKE) then MEKE%Kh_diff(:,:) = 0.0 + htot(:,:) = 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) + htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo enddo do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(GV%m_to_H,GV%Z_to_H*G%bathyT(i,j)) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(1.0*GV%m_to_H, htot(i,j)) enddo ; enddo endif @@ -1985,6 +1995,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) 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) + CS%N2_floor = 0. 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.", & diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 307fbbe3ef..862b622d56 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -270,8 +270,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) ! Set up the spatial structure functions for the diurnal, semidiurnal, and ! low-frequency tidal components. - allocate(CS%sin_struct(isd:ied,jsd:jed,3)) ; CS%sin_struct(:,:,:) = 0.0 - allocate(CS%cos_struct(isd:ied,jsd:jed,3)) ; CS%cos_struct(:,:,:) = 0.0 + allocate(CS%sin_struct(isd:ied,jsd:jed,3), source=0.0) + allocate(CS%cos_struct(isd:ied,jsd:jed,3), source=0.0) deg_to_rad = 4.0*ATAN(1.0)/180.0 do j=js-1,je+1 ; do i=is-1,ie+1 lat_rad(i,j) = G%geoLatT(i,j)*deg_to_rad diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 31d2ab5a76..1225487eaf 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -16,7 +16,7 @@ module MOM_ALE_sponge use MOM_coms, only : sum_across_PEs use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field use MOM_diag_mediator, only : diag_ctrl -use MOM_domains, only : pass_var +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, NOTE, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -28,9 +28,6 @@ module MOM_ALE_sponge use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type -use mpp_io_mod, only : mpp_get_axis_length -use mpp_io_mod, only : axistype - implicit none ; private #include @@ -47,7 +44,7 @@ module MOM_ALE_sponge module procedure set_up_ALE_sponge_vel_field_varying end interface -!> Ddetermine the number of points which are within sponges in this computational domain. +!> Determine the number of points which are within sponges in this computational domain. !! !! Only points that have positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. It also stores the target interface heights. @@ -90,31 +87,19 @@ module MOM_ALE_sponge !> ALE sponge control structure type, public :: ALE_sponge_CS ; private integer :: nz !< The total number of layers. - integer :: nz_data !< The total number of arbritary layers (used by older code). - integer :: isc !< The starting i-index of the computational domain at h. - integer :: iec !< The ending i-index of the computational domain at h. - integer :: jsc !< The starting j-index of the computational domain at h. - integer :: jec !< The ending j-index of the computational domain at h. - integer :: IscB !< The starting I-index of the computational domain at u/v. - integer :: IecB !< The ending I-index of the computational domain at u/v. - integer :: JscB !< The starting J-index of the computational domain at u/v. - integer :: JecB !< The ending J-index of the computational domain at h. - integer :: isd !< The starting i-index of the data domain at h. - integer :: ied !< The ending i-index of the data domain at h. - integer :: jsd !< The starting j-index of the data domain at h. - integer :: jed !< The ending j-index of the data domain at h. + integer :: nz_data !< The total number of arbitrary layers (used by older code). integer :: num_col !< The number of sponge tracer points within the computational domain. integer :: num_col_u !< The number of sponge u-points within the computational domain. integer :: num_col_v !< The number of sponge v-points within the computational domain. integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field logical :: sponge_uv !< Control whether u and v are included in sponge - integer, pointer :: col_i(:) => NULL() !< Array of the i-indicies of each tracer columns being damped. - integer, pointer :: col_j(:) => NULL() !< Array of the j-indicies of each tracer columns being damped. - integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indicies of each u-columns being damped. - integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indicies of each u-columns being damped. - integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indicies of each v-columns being damped. - integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indicies of each v-columns being damped. + integer, pointer :: col_i(:) => NULL() !< Array of the i-indices of each tracer column being damped. + integer, pointer :: col_j(:) => NULL() !< Array of the j-indices of each tracer column being damped. + integer, pointer :: col_i_u(:) => NULL() !< Array of the i-indices of each u-column being damped. + integer, pointer :: col_j_u(:) => NULL() !< Array of the j-indices of each u-column being damped. + integer, pointer :: col_i_v(:) => NULL() !< Array of the i-indices of each v-column being damped. + integer, pointer :: col_j_v(:) => NULL() !< Array of the j-indices of each v-column being damped. real, pointer :: Iresttime_col(:) => NULL() !< The inverse restoring time of each tracer column [T-1 ~> s-1]. real, pointer :: Iresttime_col_u(:) => NULL() !< The inverse restoring time of each u-column [T-1 ~> s-1]. @@ -124,8 +109,8 @@ module MOM_ALE_sponge type(p2d) :: Ref_val(MAX_FIELDS_) !< The values to which the fields are damped. type(p2d) :: Ref_val_u !< The values to which the u-velocities are damped. type(p2d) :: Ref_val_v !< The values to which the v-velocities are damped. - type(p3d) :: var_u !< Pointer to the u velocities. that are being damped. - type(p3d) :: var_v !< Pointer to the v velocities. that are being damped. + type(p3d) :: var_u !< Pointer to the u velocities that are being damped. + type(p3d) :: var_v !< Pointer to the v velocities that are being damped. type(p2d) :: Ref_h !< Grid on which reference data is provided (older code). type(p2d) :: Ref_hu !< u-point grid on which reference data is provided (older code). type(p2d) :: Ref_hv !< v-point grid on which reference data is provided (older code). @@ -137,7 +122,7 @@ module MOM_ALE_sponge logical :: remap_answers_2018 !< If true, use the order of arithmetic and expressions that !! recover the answers for remapping from the end of 2018. !! Otherwise, use more robust forms of the same expressions. - logical :: hor_regrid_answers_2018 !< If true, use the order of arithmetic for horizonal regridding + logical :: hor_regrid_answers_2018 !< If true, use the order of arithmetic for horizontal regridding !! that recovers the answers from the end of 2018. Otherwise, use !! rotationally symmetric forms of the same expressions. @@ -230,7 +215,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "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, "HOR_REGRID_2018_ANSWERS", CS%hor_regrid_answers_2018, & - "If true, use the order of arithmetic for horizonal regridding that recovers "//& + "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers) call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & @@ -241,9 +226,6 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, CS%time_varying_sponges = .false. CS%nz = GV%ke - CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec - CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed - CS%iscB = G%iscB ; CS%iecB = G%iecB; CS%jscB = G%jscB ; CS%jecB = G%jecB ! number of columns to be restored CS%num_col = 0 ; CS%fldno = 0 @@ -253,9 +235,9 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, enddo ; enddo if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 - allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 - allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 + allocate(CS%Iresttime_col(CS%num_col), source=0.0) + allocate(CS%col_i(CS%num_col), source=0) + allocate(CS%col_j(CS%num_col), source=0) ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -265,7 +247,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, col = col +1 endif enddo ; enddo - ! same for total number of arbritary layers and correspondent data + ! same for total number of arbitrary layers and correspondent data CS%nz_data = nz_data allocate(CS%Ref_h%p(CS%nz_data,CS%num_col)) do col=1,CS%num_col ; do K=1,CS%nz_data @@ -284,8 +266,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then - allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)) ; Iresttime_u(:,:) = 0.0 - allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)) ; Iresttime_v(:,:) = 0.0 + allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) + allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) call pass_var(Iresttime,G%Domain) call pass_var(data_h,G%Domain) @@ -295,24 +277,24 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, if (present(Iresttime_u_in)) then Iresttime_u(:,:) = Iresttime_u_in(:,:) else - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + do j=G%jsc,G%jec ; do I=G%iscB,G%iecB Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) enddo ; enddo endif - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + do j=G%jsc,G%jec ; do I=G%iscB,G%iecB if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & CS%num_col_u = CS%num_col_u + 1 enddo ; enddo if (CS%num_col_u > 0) then - allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u(:) = 0.0 - allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u(:) = 0 - allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u(:) = 0 + allocate(CS%Iresttime_col_u(CS%num_col_u), source=0.0) + allocate(CS%col_i_u(CS%num_col_u), source=0) + allocate(CS%col_j_u(CS%num_col_u), source=0) ! Store the column indices and restoring rates in the CS structure col = 1 - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + do j=G%jsc,G%jec ; do I=G%iscB,G%iecB if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then CS%col_i_u(col) = I ; CS%col_j_u(col) = j CS%Iresttime_col_u(col) = Iresttime_u(I,j) @@ -320,7 +302,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, endif enddo ; enddo - ! same for total number of arbritary layers and correspondent data + ! same for total number of arbitrary layers and correspondent data allocate(CS%Ref_hu%p(CS%nz_data,CS%num_col_u)) do col=1,CS%num_col_u I = CS%col_i_u(col) ; j = CS%col_j_u(col) @@ -339,24 +321,24 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, if (present(Iresttime_v_in)) then Iresttime_v(:,:) = Iresttime_v_in(:,:) else - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + do J=G%jscB,G%jecB; do i=G%isc,G%iec Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) enddo ; enddo endif - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + do J=G%jscB,G%jecB; do i=G%isc,G%iec if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & CS%num_col_v = CS%num_col_v + 1 enddo ; enddo if (CS%num_col_v > 0) then - allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 - allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 - allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 + allocate(CS%Iresttime_col_v(CS%num_col_v), source=0.0) + allocate(CS%col_i_v(CS%num_col_v), source=0) + allocate(CS%col_j_v(CS%num_col_v), source=0) ! pass indices, restoring time to the CS structure col = 1 - do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec + do J=G%jscB,G%jecB ; do i=G%isc,G%iec if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then CS%col_i_v(col) = i ; CS%col_j_v(col) = j CS%Iresttime_col_v(col) = Iresttime_v(i,j) @@ -364,7 +346,7 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, endif enddo ; enddo - ! same for total number of arbritary layers and correspondent data + ! same for total number of arbitrary layers and correspondent data allocate(CS%Ref_hv%p(CS%nz_data,CS%num_col_v)) do col=1,CS%num_col_v i = CS%col_i_v(col) ; J = CS%col_j_v(col) @@ -412,12 +394,12 @@ subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) if (.not.associated(CS)) then ! There are no sponge points on this PE. - allocate(data_h(G%isd:G%ied,G%jsd:G%jed,1)) ; data_h(:,:,:) = -1.0 + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,1), source=-1.0) sponge_mask(:,:) = .false. return endif - allocate(data_h(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) ; data_h(:,:,:) = -1.0 + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,CS%nz_data), source=-1.0) sponge_mask(:,:) = .false. do c=1,CS%num_col @@ -430,7 +412,7 @@ subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) end subroutine get_ALE_sponge_thicknesses -!> This subroutine determines the number of points which are to be restoref in the computational +!> This subroutine determines the number of points which are to be restored in the computational !! domain. Only points that have positive values of Iresttime and which mask2dT indicates are ocean !! points are included in the sponges. subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Iresttime_u_in, Iresttime_v_in) @@ -493,7 +475,7 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "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, "HOR_REGRID_2018_ANSWERS", CS%hor_regrid_answers_2018, & - "If true, use the order of arithmetic for horizonal regridding that recovers "//& + "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018 and retain a bug in the 3-dimensional mask "//& "returned in certain cases. Otherwise, use rotationally symmetric "//& "forms of the same expressions and initialize the mask properly.", & @@ -510,9 +492,6 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest CS%time_varying_sponges = .true. CS%nz = GV%ke - CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec - CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed - CS%iscB = G%iscB ; CS%iecB = G%iecB; CS%jscB = G%jscB ; CS%jecB = G%jecB ! number of columns to be restored CS%num_col = 0 ; CS%fldno = 0 @@ -521,9 +500,9 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest CS%num_col = CS%num_col + 1 enddo ; enddo if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 - allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 - allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 + allocate(CS%Iresttime_col(CS%num_col), source=0.0) + allocate(CS%col_i(CS%num_col), source=0) + allocate(CS%col_j(CS%num_col), source=0) ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -543,37 +522,37 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then - allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)) ; Iresttime_u(:,:) = 0.0 - allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)) ; Iresttime_v(:,:) = 0.0 + allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) + allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) call pass_var(Iresttime,G%Domain) ! u points if (present(Iresttime_u_in)) then Iresttime_u(:,:) = Iresttime_u_in(:,:) else - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + do j=G%jsc,G%jec ; do I=G%iscB,G%iecB Iresttime_u(I,j) = 0.5 * (Iresttime(i,j) + Iresttime(i+1,j)) enddo ; enddo endif CS%num_col_u = 0 ; - do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB + do j=G%jsc,G%jec; do I=G%iscB,G%iecB if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) & CS%num_col_u = CS%num_col_u + 1 enddo ; enddo if (CS%num_col_u > 0) then - allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u = 0.0 - allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u = 0 - allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u = 0 + allocate(CS%Iresttime_col_u(CS%num_col_u), source=0.0) + allocate(CS%col_i_u(CS%num_col_u), source=0) + allocate(CS%col_j_u(CS%num_col_u), source=0) ! pass indices, restoring time to the CS structure col = 1 - do j=CS%jsc,CS%jec ; do I=CS%iscB,CS%iecB + do j=G%jsc,G%jec ; do I=G%iscB,G%iecB if ((Iresttime_u(I,j)>0.0) .and. (G%mask2dCu(I,j)>0)) then CS%col_i_u(col) = i ; CS%col_j_u(col) = j CS%Iresttime_col_u(col) = Iresttime_u(i,j) col = col + 1 endif enddo ; enddo - ! same for total number of arbritary layers and correspondent data + ! same for total number of arbitrary layers and correspondent data endif total_sponge_cols_u = CS%num_col_u call sum_across_PEs(total_sponge_cols_u) @@ -583,22 +562,22 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest if (present(Iresttime_v_in)) then Iresttime_v(:,:) = Iresttime_v_in(:,:) else - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + do J=G%jscB,G%jecB; do i=G%isc,G%iec Iresttime_v(i,J) = 0.5 * (Iresttime(i,j) + Iresttime(i,j+1)) enddo ; enddo endif CS%num_col_v = 0 ; - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec + do J=G%jscB,G%jecB; do i=G%isc,G%iec if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) & CS%num_col_v = CS%num_col_v + 1 enddo ; enddo if (CS%num_col_v > 0) then - allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 - allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 - allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 + allocate(CS%Iresttime_col_v(CS%num_col_v), source=0.0) + allocate(CS%col_i_v(CS%num_col_v), source=0) + allocate(CS%col_j_v(CS%num_col_v), source=0) ! pass indices, restoring time to the CS structure col = 1 - do J=CS%jscB,CS%jecB ; do i=CS%isc,CS%iec + do J=G%jscB,G%jecB ; do i=G%isc,G%iec if ((Iresttime_v(i,J)>0.0) .and. (G%mask2dCv(i,J)>0)) then CS%col_i_v(col) = i ; CS%col_j_v(col) = j CS%Iresttime_col_v(col) = Iresttime_v(i,j) @@ -630,16 +609,16 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS, US) CS%id_sp_tendency(1) = -1 CS%id_sp_tendency(1) = register_diag_field('ocean_model', 'sp_tendency_temp', diag%axesTL, Time, & - 'Time tendency due to temperature restoring', 'degC s-1',conversion=US%s_to_T) + 'Time tendency due to temperature restoring', 'degC s-1', conversion=US%s_to_T) CS%id_sp_tendency(2) = -1 CS%id_sp_tendency(2) = register_diag_field('ocean_model', 'sp_tendency_salt', diag%axesTL, Time, & - 'Time tendency due to salinity restoring', 'g kg-1 s-1',conversion=US%s_to_T) + 'Time tendency due to salinity restoring', 'g kg-1 s-1', conversion=US%s_to_T) CS%id_sp_u_tendency = -1 CS%id_sp_u_tendency = register_diag_field('ocean_model', 'sp_tendency_u', diag%axesCuL, Time, & - 'Zonal acceleration due to sponges', 'm s-2',conversion=US%L_T2_to_m_s2) + 'Zonal acceleration due to sponges', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_sp_v_tendency = -1 CS%id_sp_v_tendency = register_diag_field('ocean_model', 'sp_tendency_v', diag%axesCvL, Time, & - 'Meridional acceleration due to sponges', 'm s-2',conversion=US%L_T2_to_m_s2) + 'Meridional acceleration due to sponges', 'm s-2', conversion=US%L_T2_to_m_s2) end subroutine init_ALE_sponge_diags @@ -670,8 +649,7 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS) ! stores the reference profile CS%Ref_val(CS%fldno)%nz_data = CS%nz_data - allocate(CS%Ref_val(CS%fldno)%p(CS%nz_data,CS%num_col)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 + allocate(CS%Ref_val(CS%fldno)%p(CS%nz_data,CS%num_col), source=0.0) do col=1,CS%num_col do k=1,CS%nz_data CS%Ref_val(CS%fldno)%p(k,col) = sp_val(CS%col_i(col),CS%col_j(col),k) @@ -709,7 +687,6 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, integer :: nz_data !< the number of vertical levels in this input field character(len=256) :: mesg ! String for error messages ! Local variables for ALE remapping - real, dimension(:), allocatable :: tmpT1d real :: zTopOfCell, zBottomOfCell ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays @@ -719,29 +696,26 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed CS%fldno = CS%fldno + 1 if (CS%fldno > MAX_FIELDS_) then - write(mesg,'("Increase MAX_FIELDS_ to at least ",I3," in MOM_memory.h or decrease & - &the number of fields to be damped in the call to & - &initialize_ALE_sponge." )') CS%fldno + write(mesg, '("Increase MAX_FIELDS_ to at least ",I3," in MOM_memory.h or decrease "//& + "the number of fields to be damped in the call to initialize_ALE_sponge." )') CS%fldno call MOM_error(FATAL,"set_up_ALE_sponge_field: "//mesg) endif - ! get a unique time interp id for this field. If sponge data is ongrid, then setup + ! get a unique time interp id for this field. If sponge data is on-grid, then setup ! to only read on the computational domain if (CS%spongeDataOngrid) then CS%Ref_val(CS%fldno)%id = init_external_field(filename, fieldname, MOM_domain=G%Domain) else CS%Ref_val(CS%fldno)%id = init_external_field(filename, fieldname) endif - fld_sz(1:4)=-1 + fld_sz(1:4) = -1 call get_external_field_info(CS%Ref_val(CS%fldno)%id, size=fld_sz) nz_data = fld_sz(3) CS%Ref_val(CS%fldno)%nz_data = nz_data !< individual sponge fields may reside on a different vertical grid CS%Ref_val(CS%fldno)%num_tlevs = fld_sz(4) ! initializes the target profile array for this field ! for all columns which will be masked - allocate(CS%Ref_val(CS%fldno)%p(nz_data,CS%num_col)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 - allocate( CS%Ref_val(CS%fldno)%h(nz_data,CS%num_col) ) - CS%Ref_val(CS%fldno)%h(:,:) = 0.0 + allocate(CS%Ref_val(CS%fldno)%p(nz_data,CS%num_col), source=0.0) + allocate(CS%Ref_val(CS%fldno)%h(nz_data,CS%num_col), source=0.0) CS%var(CS%fldno)%p => f_ptr end subroutine set_up_ALE_sponge_field_varying @@ -749,17 +723,19 @@ end subroutine set_up_ALE_sponge_field_varying !> This subroutine stores the reference profile at u and v points for the variable !! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers but - !! not to exceed the total number of model layers + intent(in) :: u_val !< u field to be used in the sponge [L T-1 ~> m s-1], + !! it is provided on its own vertical grid that may + !! have fewer layers than the model itself, but not more. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers but - !! not to exceed the number of model layers - real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u pointer to the field to be damped - real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v pointer to the field to be damped + intent(in) :: v_val !< v field to be used in the sponge [L T-1 ~> m s-1], + !! it is provided on its own vertical grid that may + !! have fewer layers than the model itself, but not more. + real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u-field to be damped [L T-1 ~> m s-1] + real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v-field to be damped [L T-1 ~> m s-1] integer :: j, k, col, fld_sz(4) character(len=256) :: mesg ! String for error messages @@ -767,16 +743,14 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, if (.not.associated(CS)) return ! stores the reference profile - allocate(CS%Ref_val_u%p(CS%nz_data,CS%num_col_u)) - CS%Ref_val_u%p(:,:) = 0.0 + allocate(CS%Ref_val_u%p(CS%nz_data,CS%num_col_u), source=0.0) do col=1,CS%num_col_u do k=1,CS%nz_data CS%Ref_val_u%p(k,col) = u_val(CS%col_i_u(col),CS%col_j_u(col),k) enddo enddo CS%var_u%p => u_ptr - allocate(CS%Ref_val_v%p(CS%nz_data,CS%num_col_v)) - CS%Ref_val_v%p(:,:) = 0.0 + allocate(CS%Ref_val_v%p(CS%nz_data,CS%num_col_v), source=0.0) do col=1,CS%num_col_v do k=1,CS%nz_data CS%Ref_val_v%p(k,col) = v_val(CS%col_i_v(col),CS%col_j_v(col),k) @@ -795,15 +769,16 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename character(len=*), intent(in) :: filename_v !< File name for v field character(len=*), intent(in) :: fieldname_v !< Name of v variable in file type(time_type), intent(in) :: Time !< Model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid (in) - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u pointer to the field to be damped (in). - real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Ocean grid (in) + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, target, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_ptr !< u-field to be damped [L T-1 ~> m s-1] + real, target, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v_ptr !< v-field to be damped [L T-1 ~> m s-1] + ! Local variables - real, allocatable, dimension(:,:,:) :: u_val !< U field to be used in the sponge. - real, allocatable, dimension(:,:,:) :: v_val !< V field to be used in the sponge. + real, allocatable, dimension(:,:,:) :: u_val !< U field to be used in the sponge [L T-1 ~> m s-1]. + real, allocatable, dimension(:,:,:) :: v_val !< V field to be used in the sponge [L T-1 ~> m s-1]. real, allocatable, dimension(:), target :: z_in, z_edges_in real :: missing_value @@ -814,9 +789,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename integer :: isdB, iedB, jsdB, jedB integer, dimension(4) :: fld_sz character(len=256) :: mesg ! String for error messages - type(axistype), dimension(4) :: axes_data integer :: tmp - integer :: axis_sizes(4) if (.not.associated(CS)) return override =.true. @@ -847,15 +820,11 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename CS%Ref_val_v%num_tlevs = fld_sz(4) ! stores the reference profile - allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u)) - CS%Ref_val_u%p(:,:) = 0.0 - allocate(CS%Ref_val_u%h(fld_sz(3),CS%num_col_u) ) - CS%Ref_val_u%h(:,:) = 0.0 + allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u), source=0.0) + allocate(CS%Ref_val_u%h(fld_sz(3),CS%num_col_u), source=0.0) CS%var_u%p => u_ptr - allocate(CS%Ref_val_v%p(fld_sz(3),CS%num_col_v)) - CS%Ref_val_v%p(:,:) = 0.0 - allocate(CS%Ref_val_v%h(fld_sz(3),CS%num_col_v) ) - CS%Ref_val_v%h(:,:) = 0.0 + allocate(CS%Ref_val_v%p(fld_sz(3),CS%num_col_v), source=0.0) + allocate(CS%Ref_val_v%h(fld_sz(3),CS%num_col_v), source=0.0) CS%var_v%p => v_ptr end subroutine set_up_ALE_sponge_vel_field_varying @@ -880,8 +849,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid real, dimension(SZK_(GV)) :: h_col ! A column of thicknesses at h, u or v points [H ~> m or kg m-2] real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields - real, allocatable, dimension(:,:,:) :: sp_val_u ! A temporary array for fields - real, allocatable, dimension(:,:,:) :: sp_val_v ! A temporary array for fields real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts real, allocatable, dimension(:,:,:) :: mask_u ! A temporary array for field mask at u pts real, allocatable, dimension(:,:,:) :: mask_v ! A temporary array for field mask at v pts @@ -893,10 +860,15 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real, dimension(:), allocatable :: tmpT1d integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz, nz_data integer :: col, total_sponge_cols - real, allocatable, dimension(:), target :: z_in, z_edges_in - real :: missing_value, Idt - real :: h_neglect, h_neglect_edge - real :: zTopOfCell, zBottomOfCell ! Heights [Z ~> m]. + real, allocatable, dimension(:), target :: z_in ! The depths (positive downward) in the input file [Z ~> m] + real, allocatable, dimension(:), target :: z_edges_in ! The depths (positive downward) of the + ! edges in the input file [Z ~> m] + real :: missing_value + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] + real :: zTopOfCell, zBottomOfCell ! Interface heights (positive upward) in the input dataset [Z ~> m]. + real :: sp_val_u ! Interpolation of sp_val to u-points + real :: sp_val_v ! Interpolation of sp_val to v-points integer :: nPoints is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -917,8 +889,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data - allocate(sp_val(G%isd:G%ied,G%jsd:G%jed,1:nz_data)); sp_val(:,:,:) = 0.0 - allocate(mask_z(G%isd:G%ied,G%jsd:G%jed,1:nz_data)); mask_z(:,:,:) = 0.0 call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, 1.0, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & @@ -932,7 +902,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 do k=1,nz_data if (mask_z(CS%col_i(c),CS%col_j(c),k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(CS%col_i(c),CS%col_j(c)) ) + zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(CS%col_i(c),CS%col_j(c)) ) tmpT1d(k) = sp_val(CS%col_i(c),CS%col_j(c),k) elseif (k>1) then zBottomOfCell = -G%bathyT(CS%col_i(c),CS%col_j(c)) @@ -964,7 +934,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) nz_data = CS%Ref_val(m)%nz_data allocate(tmp_val2(CS%Ref_val(m)%nz_data)) if (CS%id_sp_tendency(m) > 0) then - allocate(tmp(G%isd:G%ied,G%jsd:G%jed,nz));tmp(:,:,:) = 0.0 + allocate(tmp(G%isd:G%ied,G%jsd:G%jed,nz), source=0.0) endif do c=1,CS%num_col ! c is an index for the next 3 lines but a multiplier for the rest of the loop @@ -1005,44 +975,44 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) call MOM_error(FATAL,"apply_ALE_sponge: No time information provided") nz_data = CS%Ref_val_u%nz_data - allocate(sp_val(G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - allocate(sp_val_u(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) - allocate(mask_u(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) - allocate(mask_z(G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - sp_val(:,:,:) = 0.0 - sp_val_u(:,:,:) = 0.0 - mask_u(:,:,:) = 0.0 - mask_z(:,:,:) = 0.0 ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, 1.0, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answers_2018=CS%hor_regrid_answers_2018) - call pass_var(sp_val,G%Domain) - do j=CS%jsc,CS%jec; do I=CS%iscB,CS%iecB - sp_val_u(I,j,1:nz_data) = 0.5*(sp_val(i,j,1:nz_data)+sp_val(i+1,j,1:nz_data)) - mask_u(I,j,1:nz_data) = max(mask_z(i,j,1:nz_data),mask_z(i+1,j,1:nz_data)) + ! Initialize mask_z halos to zero before pass_var, in case of no update + mask_z(G%isc-1, G%jsc:G%jec, :) = 0. + mask_z(G%iec+1, G%jsc:G%jec, :) = 0. + call pass_var(sp_val, G%Domain) + call pass_var(mask_z, G%Domain) + + allocate(mask_u(G%isdB:G%iedB,G%jsd:G%jed,1:nz_data)) + do j=G%jsc,G%jec; do I=G%iscB,G%iecB + mask_u(I,j,1:nz_data) = min(mask_z(i,j,1:nz_data),mask_z(i+1,j,1:nz_data)) enddo ; enddo allocate( hsrc(nz_data) ) - allocate( tmpT1d(nz_data) ) do c=1,CS%num_col_u ! c is an index for the next 3 lines but a multiplier for the rest of the loop ! Therefore we use c as per C code and increment the index where necessary. i = CS%col_i_u(c) ; j = CS%col_j_u(c) - CS%Ref_val_u%p(1:nz_data,c) = sp_val_u(i,j,1:nz_data) + if (mask_u(i,j,1) == 1.0) then + do k=1,nz_data + sp_val_u = 0.5 * (sp_val(i,j,k) + sp_val(i+1,j,k)) + CS%Ref_val_u%p(k,c) = sp_val_u + enddo + else + CS%Ref_val_u%p(1:nz_data,c) = 0.0 + endif ! Build the source grid - zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 + zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0 do k=1,nz_data if (mask_u(i,j,k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) - tmpT1d(k) = sp_val_u(i,j,k) + zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(i,j) ) elseif (k>1) then zBottomOfCell = -G%bathyT(i,j) - tmpT1d(k) = tmpT1d(k-1) else ! This next block should only ever be reached over land - tmpT1d(k) = -99.9 endif hsrc(k) = zTopOfCell - zBottomOfCell if (hsrc(k)>0.) nPoints = nPoints + 1 @@ -1052,44 +1022,45 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(i,j) ) CS%Ref_val_u%h(1:nz_data,c) = GV%Z_to_H*hsrc(1:nz_data) enddo - deallocate(sp_val, sp_val_u, mask_u, mask_z, hsrc, tmpT1d) + deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data - allocate(sp_val( G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - allocate(sp_val_v(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) - allocate(mask_v(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) - allocate(mask_z(G%isd:G%ied,G%jsd:G%jed,1:nz_data)) - sp_val(:,:,:) = 0.0 - sp_val_v(:,:,:) = 0.0 - mask_z(:,:,:) = 0.0 ! Interpolate from the external horizontal grid and in time call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, 1.0, G, sp_val, mask_z, z_in, & z_edges_in, missing_value, CS%reentrant_x, CS%tripolar_N, .false., & spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& answers_2018=CS%hor_regrid_answers_2018) - call pass_var(sp_val,G%Domain) - do J=CS%jscB,CS%jecB; do i=CS%isc,CS%iec - sp_val_v(i,J,1:nz_data) = 0.5*(sp_val(i,j,1:nz_data)+sp_val(i,j+1,1:nz_data)) - mask_v(i,J,1:nz_data) = max(mask_z(i,j,1:nz_data),mask_z(i,j+1,1:nz_data)) + ! Initialize mask_z halos to zero before pass_var, in case of no update + mask_z(G%isc:G%iec, G%jsc-1, :) = 0. + mask_z(G%isc:G%iec, G%jec+1, :) = 0. + call pass_var(sp_val, G%Domain) + call pass_var(mask_z, G%Domain) + + allocate(mask_v(G%isd:G%ied,G%jsdB:G%jedB,1:nz_data)) + do J=G%jscB,G%jecB; do i=G%isc,G%iec + mask_v(i,J,1:nz_data) = min(mask_z(i,j,1:nz_data),mask_z(i,j+1,1:nz_data)) enddo ; enddo !call pass_var(mask_z,G%Domain) allocate( hsrc(nz_data) ) - allocate( tmpT1d(nz_data) ) do c=1,CS%num_col_v ! c is an index for the next 3 lines but a multiplier for the rest of the loop ! Therefore we use c as per C code and increment the index where necessary. i = CS%col_i_v(c) ; j = CS%col_j_v(c) - CS%Ref_val_v%p(1:nz_data,c) = sp_val_v(i,j,1:nz_data) + if (mask_v(i,j,1) == 1.0) then + do k=1,nz_data + sp_val_v = 0.5 * (sp_val(i,j,k) + sp_val(i,j+1,k)) + CS%Ref_val_v%p(k,c) = sp_val_v + enddo + else + CS%Ref_val_v%p(1:nz_data,c) = 0.0 + endif ! Build the source grid - zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0; tmpT1d(:) = -99.9 + zTopOfCell = 0. ; zBottomOfCell = 0. ; nPoints = 0; hsrc(:) = 0.0 do k=1,nz_data if (mask_v(i,j,k) == 1.0) then - zBottomOfCell = -min( z_edges_in(k+1), G%bathyT(i,j) ) - tmpT1d(k) = sp_val_v(i,j,k) + zBottomOfCell = -min( z_edges_in(k+1) - G%Z_ref, G%bathyT(i,j) ) elseif (k>1) then zBottomOfCell = -G%bathyT(i,j) - tmpT1d(k) = tmpT1d(k-1) else ! This next block should only ever be reached over land - tmpT1d(k) = -99.9 endif hsrc(k) = zTopOfCell - zBottomOfCell if (hsrc(k)>0.) nPoints = nPoints + 1 @@ -1099,14 +1070,14 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(i,j) ) CS%Ref_val_v%h(1:nz_data,c) = GV%Z_to_H*hsrc(1:nz_data) enddo - deallocate(sp_val, sp_val_v, mask_v, mask_z, hsrc, tmpT1d) + deallocate(sp_val, mask_v, mask_z, hsrc) endif call pass_var(h,G%Domain) nz_data = CS%Ref_val_u%nz_data allocate(tmp_val2(nz_data)) if (CS%id_sp_u_tendency > 0) then - allocate(tmp_u(G%isdB:G%iedB,G%jsd:G%jed,nz));tmp_u(:,:,:)=0.0 + allocate(tmp_u(G%isdB:G%iedB,G%jsd:G%jed,nz), source=0.0) endif ! u points do c=1,CS%num_col_u @@ -1136,7 +1107,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) endif ! v points if (CS%id_sp_v_tendency > 0) then - allocate(tmp_v(G%isd:G%ied,G%jsdB:G%jedB,nz));tmp_v(:,:,:)=0.0 + allocate(tmp_v(G%isd:G%ied,G%jsdB:G%jedB,nz), source=0.0) endif nz_data = CS%Ref_val_v%nz_data allocate(tmp_val2(nz_data)) @@ -1169,9 +1140,6 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) deallocate(tmp_val2) endif - - - end subroutine apply_ALE_sponge !> Rotate the ALE sponge fields from the input to the model index map. @@ -1205,15 +1173,13 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) fixed_sponge = .not. sponge_in%time_varying_sponges ! NOTE: nz_data is only conditionally set when fixed_sponge is true. - allocate(Iresttime_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed)) + allocate(Iresttime_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(Iresttime(G%isd:G%ied, G%jsd:G%jed)) - Iresttime_in(:,:) = 0.0 if (fixed_sponge) then nz_data = sponge_in%nz_data - allocate(data_h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz_data)) + allocate(data_h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz_data), source=0.0) allocate(data_h(G%isd:G%ied, G%jsd:G%jed, nz_data)) - data_h_in(:,:,:) = 0. endif ! Re-populate the 2D Iresttime and data_h arrays on the original grid @@ -1282,10 +1248,8 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) nz_data = sponge_in%Ref_val(n)%nz_data sponge%Ref_val(n)%nz_data = nz_data - allocate(sponge%Ref_val(n)%p(nz_data, sponge_in%num_col)) - allocate(sponge%Ref_val(n)%h(nz_data, sponge_in%num_col)) - sponge%Ref_val(n)%p(:,:) = 0.0 - sponge%Ref_val(n)%h(:,:) = 0.0 + allocate(sponge%Ref_val(n)%p(nz_data, sponge_in%num_col), source=0.0) + allocate(sponge%Ref_val(n)%h(nz_data, sponge_in%num_col), source=0.0) ! TODO: There is currently no way to associate a generic field pointer to ! its rotated equivalent without introducing a new data structure which diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 4dcaa70bc2..0711d2291d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -577,49 +577,29 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_La_SL = register_diag_field('ocean_model', 'KPP_La_SL', diag%axesT1, Time, & 'Surface-layer Langmuir number computed in [CVMix] KPP','nondim') - allocate( CS%N( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - CS%N(:,:,:) = 0. - allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) - CS%OBLdepth(:,:) = 0. - allocate( CS%kOBL( SZI_(G), SZJ_(G) ) ) - CS%kOBL(:,:) = 0. - allocate( CS%La_SL( SZI_(G), SZJ_(G) ) ) - CS%La_SL(:,:) = 0. - allocate( CS%Vt2( SZI_(G), SZJ_(G),SZK_(GV) ) ) - CS%Vt2(:,:,:) = 0. + allocate( CS%N( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%kOBL( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%La_SL( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%Vt2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) - allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0 - if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. - if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_BulkUz2 > 0) CS%Uz2(:,:,:) = 0. - if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_BulkRi > 0) CS%BulkRi(:,:,:) = 0. - if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Sigma > 0) CS%sigma(:,:,:) = 0. - if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_Ws > 0) CS%Ws(:,:,:) = 0. - if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_N2 > 0) CS%N2(:,:,:) = 0. - if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Kt_KPP > 0) CS%Kt_KPP(:,:,:) = 0. - if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Ks_KPP > 0) CS%Ks_KPP(:,:,:) = 0. - if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Kv_KPP > 0) CS%Kv_KPP(:,:,:) = 0. - if (CS%id_Tsurf > 0) allocate( CS%Tsurf( SZI_(G), SZJ_(G)) ) - if (CS%id_Tsurf > 0) CS%Tsurf(:,:) = 0. - if (CS%id_Ssurf > 0) allocate( CS%Ssurf( SZI_(G), SZJ_(G)) ) - if (CS%id_Ssurf > 0) CS%Ssurf(:,:) = 0. - if (CS%id_Usurf > 0) allocate( CS%Usurf( SZIB_(G), SZJ_(G)) ) - if (CS%id_Usurf > 0) CS%Usurf(:,:) = 0. - if (CS%id_Vsurf > 0) allocate( CS%Vsurf( SZI_(G), SZJB_(G)) ) - if (CS%id_Vsurf > 0) CS%Vsurf(:,:) = 0. - if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G),SZK_(GV)) ) - if (CS%id_EnhVt2 > 0) CS%EnhVt2(:,:,:) = 0. - if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_EnhK > 0) CS%EnhK(:,:,:) = 0. + allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ), source=0.0 ) + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Tsurf > 0) allocate( CS%Tsurf( SZI_(G), SZJ_(G) ), source=0. ) + if (CS%id_Ssurf > 0) allocate( CS%Ssurf( SZI_(G), SZJ_(G) ), source=0. ) + if (CS%id_Usurf > 0) allocate( CS%Usurf( SZIB_(G), SZJ_(G) ), source=0. ) + if (CS%id_Vsurf > 0) allocate( CS%Vsurf( SZI_(G), SZJB_(G) ), source=0. ) + if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) id_clock_KPP_calc = cpu_clock_id('Ocean KPP calculate)', grain=CLOCK_MODULE) id_clock_KPP_compute_BLD = cpu_clock_id('(Ocean KPP comp BLD)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 35e5352a9f..87e5107acd 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -289,26 +289,26 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2', conversion=US%s_to_T**2) if (CS%id_N2 > 0) then - allocate( CS%N2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) ; CS%N2(:,:,:) = 0. + allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_CVMix_shear module','1/s2', conversion=US%s_to_T**2) if (CS%id_S2 > 0) then - allocate( CS%S2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) ; CS%S2(:,:,:) = 0. + allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) endif CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G),SZK_(GV)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=1.e8 ) endif CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', & diag%axesTi, Time, & 'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value - allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G),SZK_(GV)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 + allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=1.e8 ) endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ee27c6c5df..8d53594ebb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -45,7 +45,7 @@ module MOM_diabatic_aux real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T [Z ~> m]. logical :: reclaim_frazil !< If true, try to use any frazil heat deficit to !! to cool the topmost layer down to the freezing - !! point. The default is false. + !! point. The default is true. logical :: pressure_dependent_frazil !< If true, use a pressure dependent !! freezing temperature when making frazil. The !! default is false, which will be faster but is @@ -1657,8 +1657,8 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori ! need both arrays for the SW diagnostics (one for flux, one for convergence) if (CS%id_penSW_diag>0 .or. CS%id_penSWflux_diag>0) then - allocate(CS%penSW_diag(isd:ied,jsd:jed,nz)) ; CS%penSW_diag(:,:,:) = 0.0 - allocate(CS%penSWflux_diag(isd:ied,jsd:jed,nz+1)) ; CS%penSWflux_diag(:,:,:) = 0.0 + allocate(CS%penSW_diag(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%penSWflux_diag(isd:ied,jsd:jed,nz+1), source=0.0) endif ! diagnostic for non-downwelling SW radiation (i.e., SW absorbed at ocean surface) @@ -1668,7 +1668,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='nondownwelling_shortwave_flux_in_sea_water') if (CS%id_nonpenSW_diag > 0) then - allocate(CS%nonpenSW_diag(isd:ied,jsd:jed)) ; CS%nonpenSW_diag(:,:) = 0.0 + allocate(CS%nonpenSW_diag(isd:ied,jsd:jed), source=0.0) endif endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index c4ba950c1c..c9df559583 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -340,7 +340,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & 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 find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0, dZref=G%Z_ref) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -2545,8 +2545,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !! Diagnostics for terms multiplied by fractional thicknesses if (CS%id_hf_dudt_dia_2d > 0) then - allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_dudt_dia_2d(:,:) = 0.0 + allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_dudt_dia_2d(I,j) = hf_dudt_dia_2d(I,j) + ADp%du_dt_dia(I,j,k) * ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -2555,8 +2554,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif if (CS%id_hf_dvdt_dia_2d > 0) then - allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dvdt_dia_2d(:,:) = 0.0 + allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_dvdt_dia_2d(i,J) = hf_dvdt_dia_2d(i,J) + ADp%dv_dt_dia(i,J,k) * ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -2869,8 +2867,8 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the !! tracer flow control module -! 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_diabatic_driver" ! This module's name. if (associated(CS)) then @@ -2882,10 +2880,35 @@ subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & CS%diag => diag if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp -! Set default, read and log parameters + ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") + ! Check for any subsidiary parameters that are inconsistent with the adiabatic mode. + 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 "//& + "specified via calls to initialize_sponge and possibly "//& + "set_up_sponge_field.", default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", CS%use_energetic_PBL, & + "If true, use an implied energetics planetary boundary "//& + "layer scheme to determine the diffusivity and viscosity "//& + "in the surface boundary layer.", default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_KPP", CS%use_KPP, & + "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "//& + "to calculate diffusivities and non-local transport in the OBL.", & + default=.false., do_not_log=.true.) + + if (CS%use_sponge) call MOM_error(WARNING, & + "When ADIABATIC = True, it is inconsistent to set SPONGE = True.") + if (CS%use_energetic_PBL) call MOM_error(WARNING, & + "When ADIABATIC = True, it is inconsistent to set ENERGETICS_SFC_PBL = True.") + if (CS%use_KPP) call MOM_error(WARNING, & + "When ADIABATIC = True, it is inconsistent to set USE_KPP = True.") + + if (CS%use_sponge .or. CS%use_energetic_PBL .or. CS%use_KPP) & + call MOM_error(FATAL, "adiabatic_driver_init is aborting due to inconsistent parameter settings.") + end subroutine adiabatic_driver_init @@ -2910,13 +2933,14 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure type(oda_incupd_CS), pointer :: oda_incupd_CSp !< pointer to the oda incupd module control structure + ! Local variables real :: Kd ! A diffusivity used in the default for other tracer diffusivities, in MKS units [m2 s-1] integer :: num_mode logical :: use_temperature character(len=20) :: EN1, EN2, EN3 -! 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_diabatic_driver" ! This module's name. character(len=48) :: thickness_units character(len=40) :: var_name @@ -3122,7 +3146,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s) - allocate(CS%id_cn(CS%nMode)) ; CS%id_cn(:) = -1 + allocate(CS%id_cn(CS%nMode), source=-1) do m=1,CS%nMode write(var_name, '("cn_mode",i1)') m write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m @@ -3235,13 +3259,13 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive CS%useKPP = KPP_init(param_file, G, GV, US, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) if (CS%useKPP) then - allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. - allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. + allocate(CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1), source=0.0) endif if (CS%useKPP) then - allocate( CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_buoy_flux(:,:,:) = 0. - allocate( CS%KPP_temp_flux(isd:ied,jsd:jed) ) ; CS%KPP_temp_flux(:,:) = 0. - allocate( CS%KPP_salt_flux(isd:ied,jsd:jed) ) ; CS%KPP_salt_flux(:,:) = 0. + allocate(CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%KPP_temp_flux(isd:ied,jsd:jed), source=0.0) + allocate(CS%KPP_salt_flux(isd:ied,jsd:jed), source=0.0) endif diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index 2195363101..7944d4b89f 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -3,7 +3,7 @@ module MOM_geothermal ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : register_static_field, time_type, diag_ctrl use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -23,22 +23,21 @@ module MOM_geothermal !> Control structure for geothermal heating type, public :: geothermal_CS ; private - real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is - !! negative) the water is heated in place instead - !! of moving upward between layers [R degC-1 ~> kg m-3 degC-1]. - real, pointer :: geo_heat(:,:) => NULL() !< The geothermal heat flux [J m-2 T-1 ~> W m-2]. + real :: dRcv_dT_inplace !< The value of dRcv_dT above which (dRcv_dT is negative) the + !! water is heated in place instead of moving upward between + !! layers in non-ALE layered mode [R degC-1 ~> kg m-3 degC-1] + real, allocatable, dimension(:,:) :: geo_heat !< The geothermal heat flux [J m-2 T-1 ~> W m-2] real :: geothermal_thick !< The thickness over which geothermal heating is - !! applied [H ~> m or kg m-2]. - logical :: apply_geothermal !< If true, geothermal heating will be applied - !! otherwise GEOTHERMAL_SCALE has been set to 0 and - !! there is no heat to apply. - - 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 + !! applied [H ~> m or kg m-2] + logical :: apply_geothermal !< If true, geothermal heating will be applied. This is false if + !! GEOTHERMAL_SCALE is 0 and there is no heat to apply. + + 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 + !! 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 @@ -532,7 +531,7 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith CS%apply_geothermal = .not.(geo_scale == 0.0) if (.not.CS%apply_geothermal) return - call safe_alloc_ptr(CS%geo_heat, isd, ied, jsd, jed) ; CS%geo_heat(:,:) = 0.0 + call safe_alloc_alloc(CS%geo_heat, isd, ied, jsd, jed) ; CS%geo_heat(:,:) = 0.0 call get_param(param_file, mdl, "GEOTHERMAL_FILE", geo_file, & "The file from which the geothermal heating is to be "//& @@ -544,7 +543,8 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith "The value of drho_dT above which geothermal heating "//& "simply heats water in place instead of moving it between "//& "isopycnal layers. This must be negative.", & - units="kg m-3 K-1", scale=US%kg_m3_to_R, default=-0.01) + units="kg m-3 K-1", scale=US%kg_m3_to_R, default=-0.01, & + do_not_log=((GV%nk_rho_varies<=0).or.(GV%nk_rho_varies>=GV%ke)) ) if (CS%dRcv_dT_inplace >= 0.0) call MOM_error(FATAL, "geothermal_init: "//& "GEOTHERMAL_DRHO_DT_INPLACE must be negative.") @@ -554,8 +554,8 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith filename = trim(inputdir)//trim(geo_file) call log_param(param_file, mdl, "INPUTDIR/GEOTHERMAL_FILE", filename) call get_param(param_file, mdl, "GEOTHERMAL_VARNAME", geotherm_var, & - "The name of the geothermal heating variable in "//& - "GEOTHERMAL_FILE.", default="geo_heat") + "The name of the geothermal heating variable in GEOTHERMAL_FILE.", & + default="geo_heat") call MOM_read_data(filename, trim(geotherm_var), CS%geo_heat, G%Domain) do j=jsd,jed ; do i=isd,ied CS%geo_heat(i,j) = (G%mask2dT(i,j) * geo_scale) * CS%geo_heat(i,j) @@ -601,7 +601,7 @@ end subroutine geothermal_init subroutine geothermal_end(CS) type(geothermal_CS), intent(inout) :: CS !< Geothermal heating control structure that !! will be deallocated in this subroutine. - deallocate(CS%geo_heat) + if (allocated(CS%geo_heat)) deallocate(CS%geo_heat) end subroutine geothermal_end !> \namespace mom_geothermal diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index a1fe88d114..df24d3f4e9 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -51,8 +51,12 @@ module MOM_int_tide_input 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) + !! for internal tide for testing (BDM) real :: int_tide_source_y !< Y Location of generation site !! for internal tide for testing (BDM) + integer :: int_tide_source_i !< I Location of generation site + integer :: int_tide_source_j !< J Location of generation site + logical :: int_tide_use_glob_ij !< Use global indices for generation site !>@{ Diagnostic IDs @@ -99,6 +103,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(time_type) :: time_end !< For use in testing internal tides (BDM) integer :: i, j, k, is, ie, js, je, nz, isd, ied, jsd, jed + integer :: i_global, j_global 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 @@ -126,13 +131,23 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (CS%int_tide_source_test) then itide%TKE_itidal_input(:,:) = 0.0 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*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3 - endif - enddo ; enddo + if (CS%int_tide_use_glob_ij) then + do j=js,je ; do i=is,ie + i_global = i + G%idg_offset + j_global = j + G%jdg_offset + if ((i_global == CS%int_tide_source_i) .and. (j_global == CS%int_tide_source_j)) then + itide%TKE_itidal_input(i,j) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3 + endif + enddo ; enddo + else + do j=js,je ; do i=is,ie + ! Input an arbitrary energy point source.id_ + if (((G%geoLonCu(I-1,j)-CS%int_tide_source_x) * (G%geoLonBu(I,j)-CS%int_tide_source_x) <= 0.0) .and. & + ((G%geoLatCv(i,J-1)-CS%int_tide_source_y) * (G%geoLatCv(i,j)-CS%int_tide_source_y) <= 0.0)) then + itide%TKE_itidal_input(i,j) = 1.0*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**3 + endif + enddo ; enddo + endif endif endif @@ -340,11 +355,11 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0, scale=US%m_s_to_L_T) - allocate(itide%Nb(isd:ied,jsd:jed)) ; itide%Nb(:,:) = 0.0 - allocate(itide%h2(isd:ied,jsd:jed)) ; itide%h2(:,:) = 0.0 - allocate(itide%TKE_itidal_input(isd:ied,jsd:jed)) ; itide%TKE_itidal_input(:,:) = 0.0 - allocate(itide%tideamp(isd:ied,jsd:jed)) ; itide%tideamp(:,:) = utide - allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed)) ; CS%TKE_itidal_coef(:,:) = 0.0 + allocate(itide%Nb(isd:ied,jsd:jed), source=0.0) + allocate(itide%h2(isd:ied,jsd:jed), source=0.0) + allocate(itide%TKE_itidal_input(isd:ied,jsd:jed), source=0.0) + allocate(itide%tideamp(isd:ied,jsd:jed), source=utide) + allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed), source=0.0) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& @@ -389,25 +404,44 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "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_USE_GLOB_IJ", CS%int_tide_use_glob_ij, & + "Use global IJ for interal tide generation source test", default=.false.) 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.) + "X Location of generation site for internal tide", default=1., & + do_not_log=CS%int_tide_use_glob_ij) 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.) + "Y Location of generation site for internal tide", default=1., & + do_not_log=CS%int_tide_use_glob_ij) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_I", CS%int_tide_source_i, & + "I Location of generation site for internal tide", default=0, & + do_not_log=.not.CS%int_tide_use_glob_ij) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_J", CS%int_tide_source_j, & + "J Location of generation site for internal tide", default=0, & + do_not_log=.not.CS%int_tide_use_glob_ij) 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) + + if ((CS%int_tide_use_glob_ij) .and. ((CS%int_tide_source_x /= 1.) .or. (CS%int_tide_source_y /= 1.))) then + call MOM_error(FATAL, "MOM_internal_tide_input: "//& + "Internal tide source set to use (i,j) indices hence (x,y) geographical coords are meaningless.") + endif + if ((.not.CS%int_tide_use_glob_ij) .and. ((CS%int_tide_source_i /= 0) .or. (CS%int_tide_source_j /= 0))) then + call MOM_error(FATAL, "MOM_internal_tide_input: "//& + "Internal tide source set to use (x,y) geographical coords hence (i,j) indices are meaningless.") + endif 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 + if (G%bathyT(i,j) + G%Z_ref < min_zbot_itides) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) ! 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)) + itide%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [R Z3 T-2 ~> J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*US%L_to_Z*kappa_h2_factor*GV%Rho0*& diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 0b6a3cf76c..51c67504d4 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -1097,7 +1097,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) if (.not.associated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) - allocate(CS%id_opacity(optics%nbands)) ; CS%id_opacity(:) = -1 + allocate(CS%id_opacity(optics%nbands), source=-1) CS%id_sw_pen = register_diag_field('ocean_model', 'SW_pen', diag%axesT1, Time, & 'Penetrating shortwave radiation flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f4874252f4..4ce947e817 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -198,16 +198,6 @@ module MOM_set_diffusivity contains -!> Sets the interior vertical diffusion of scalars due to the following processes: -!! 1. Shear-driven mixing: two options, Jackson et at. and KPP interior; -!! 2. Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by -!! Harrison & Hallberg, JPO 2008; -!! 3. Double-diffusion, old method and new method via CVMix; -!! 4. Tidal mixing: many options available, see MOM_tidal_mixing.F90; -!! In addition, this subroutine has the option to set the interior vertical -!! 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, & G, GV, US, CS, Kd_lay, Kd_int, Kd_extra_T, Kd_extra_S) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -319,40 +309,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set up arrays for diagnostics. - if (CS%id_N2 > 0) then - allocate(dd%N2_3d(isd:ied,jsd:jed,nz+1)) ; dd%N2_3d(:,:,:) = 0.0 - endif - if (CS%id_Kd_user > 0) then - allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1)) ; dd%Kd_user(:,:,:) = 0.0 - endif - if (CS%id_Kd_work > 0) then - allocate(dd%Kd_work(isd:ied,jsd:jed,nz)) ; dd%Kd_work(:,:,:) = 0.0 - endif - if (CS%id_maxTKE > 0) then - allocate(dd%maxTKE(isd:ied,jsd:jed,nz)) ; dd%maxTKE(:,:,:) = 0.0 - endif - if (CS%id_TKE_to_Kd > 0) then - allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 - endif - if ((CS%double_diffusion) .and. (CS%id_KT_extra > 0)) then - allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 - endif - if ((CS%double_diffusion) .and. (CS%id_KS_extra > 0)) then - allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 - endif - if (CS%id_R_rho > 0) then - allocate(dd%drho_rat(isd:ied,jsd:jed,nz+1)) ; dd%drho_rat(:,:,:) = 0.0 - endif - if (CS%id_Kd_BBL > 0) then - allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 - endif - - if (CS%id_Kd_bkgnd > 0) then - allocate(dd%Kd_bkgnd(isd:ied,jsd:jed,nz+1)) ; dd%Kd_bkgnd(:,:,:) = 0. - endif - if (CS%id_Kv_bkgnd > 0) then - allocate(dd%Kv_bkgnd(isd:ied,jsd:jed,nz+1)) ; dd%Kv_bkgnd(:,:,:) = 0. - endif + if (CS%id_N2 > 0) allocate(dd%N2_3d(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_user > 0) allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_work > 0) allocate(dd%Kd_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_maxTKE > 0) allocate(dd%maxTKE(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_to_Kd > 0) allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz), source=0.0) + if ((CS%double_diffusion) .and. (CS%id_KT_extra > 0)) & + allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1), source=0.0) + if ((CS%double_diffusion) .and. (CS%id_KS_extra > 0)) & + allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_R_rho > 0) allocate(dd%drho_rat(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_BBL > 0) allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1), source=0.0) + + if (CS%id_Kd_bkgnd > 0) allocate(dd%Kd_bkgnd(isd:ied,jsd:jed,nz+1), source=0.) + if (CS%id_Kv_bkgnd > 0) allocate(dd%Kv_bkgnd(isd:ied,jsd:jed,nz+1), source=0.) ! set up arrays for tidal mixing diagnostics if (CS%use_tidal_mixing) & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 99bd91d8f8..9770325d85 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -115,80 +115,6 @@ module MOM_set_visc contains !> Calculates the thickness of the bottom boundary layer and the viscosity within that layer. -!! -!! A drag law is used, either linearized about an assumed bottom velocity or using the -!! actual near-bottom velocities combined with an assumed unresolved velocity. The bottom -!! boundary layer thickness is limited by a combination of stratification and rotation, as -!! in the paper of Killworth and Edwards, JPO 1999. It is not necessary to calculate the -!! thickness and viscosity every time step; instead previous values may be used. -!! -!! \section set_viscous_BBL Viscous Bottom Boundary Layer -!! -!! If set_visc_cs.bottomdraglaw is True then a bottom boundary layer viscosity and thickness -!! are calculated so that the bottom stress is -!! \f[ -!! \mathbf{\tau}_b = C_d | U_{bbl} | \mathbf{u}_{bbl} -!! \f] -!! If set_visc_cs.bottomdraglaw is True then the term \f$|U_{bbl}|\f$ is set equal to the -!! value in set_visc_cs.drag_bg_vel so that \f$C_d |U_{bbl}|\f$ becomes a Rayleigh bottom drag. -!! Otherwise \f$|U_{bbl}|\f$ is found by averaging the flow over the bottom set_visc_cs.hbbl -!! of the model, adding the amplitude of tides set_visc_cs.tideamp and a constant -!! set_visc_cs.drag_bg_vel. For these calculations the vertical grid at the velocity -!! component locations is found by -!! \f[ -!! \begin{array}{ll} -!! \frac{2 h^- h^+}{h^- + h^+} & u \left( h^+ - h^-\right) >= 0 -!! \\ -!! \frac{1}{2} \left( h^- + h^+ \right) & u \left( h^+ - h^-\right) < 0 -!! \end{array} -!! \f] -!! which biases towards the thin cell if the thin cell is upwind. Biasing the grid toward -!! thin upwind cells helps increase the effect of viscosity and inhibits flow out of these -!! thin cells. -!! -!! After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer -!! thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). -!! KW99 solve the equation -!! \f[ -!! \left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 -!! \f] -!! for the boundary layer depth \f$h_{bbl}\f$. Here -!! \f[ -!! h_f = \frac{C_n u_*}{f} -!! \f] -!! is the rotation controlled boundary layer depth in the absence of stratification. -!! \f$u_*\f$ is the surface friction speed given by -!! \f[ -!! u_*^2 = C_d |U_{bbl}|^2 -!! \f] -!! and is a function of near bottom model flow. -!! \f[ -!! h_N = \frac{C_i u_*}{N} = \frac{ (C_i u_* )^2 }{g^\prime} -!! \f] -!! is the stratification controlled boundary layer depth. The non-dimensional parameters -!! \f$C_n=0.5\f$ and \f$C_i=20\f$ are suggested by Zilitinkevich and Mironov, 1996. -!! -!! If a Richardson number dependent mixing scheme is being used, as indicated by -!! set_visc_cs.rino_mix, then the boundary layer thickness is bounded to be no larger -!! than a half of set_visc_cs.hbbl . -!! -!! \todo Channel drag needs to be explained -!! -!! A BBL viscosity is calculated so that the no-slip boundary condition in the vertical -!! viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. -!! -!! \subsection set_viscous_BBL_ref References -!! -!! \arg Killworth, P. D., and N. R. Edwards, 1999: -!! A Turbulent Bottom Boundary Layer Code for Use in Numerical Ocean Models. -!! J. Phys. Oceanogr., 29, 1221-1238, -!! doi:10.1175/1520-0485(1999)029<1221:ATBBLC>2.0.CO;2 -!! \arg Zilitinkevich, S., Mironov, D.V., 1996: -!! A multi-limit formulation for the equilibrium depth of a stably stratified boundary layer. -!! Boundary-Layer Meteorology 81, 325-351. -!! doi:10.1007/BF02430334 -!! subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -228,11 +154,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) real :: Rhtot ! Running sum of thicknesses times the layer potential ! densities [H R ~> kg m-2 or kg2 m-5]. real, dimension(SZIB_(G),SZJ_(G)) :: & - D_u, & ! Bottom depth interpolated to u points [Z ~> m]. + D_u, & ! Bottom depth linearly interpolated to u points [Z ~> m]. mask_u ! A mask that disables any contributions from u points that ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZI_(G),SZJB_(G)) :: & - D_v, & ! Bottom depth interpolated to v points [Z ~> m]. + D_v, & ! Bottom depth linearly interpolated to v points [Z ~> m]. mask_v ! A mask that disables any contributions from v points that ! are land or past open boundary conditions [nondim], 0 or 1. real, dimension(SZIB_(G),SZK_(GV)) :: & @@ -399,12 +325,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) !$OMP parallel do default(shared) do J=js-1,je ; do i=is-1,ie+1 - D_v(i,J) = 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + D_v(i,J) = 0.5*(G%bathyT(i,j) + G%bathyT(i,j+1)) + G%Z_ref mask_v(i,J) = G%mask2dCv(i,J) enddo ; enddo !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-1,ie - D_u(I,j) = 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + D_u(I,j) = 0.5*(G%bathyT(i,j) + G%bathyT(i+1,j)) + G%Z_ref mask_u(I,j) = G%mask2dCu(I,j) enddo ; enddo @@ -414,13 +340,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB if (OBC%segment(n)%is_N_or_S .and. (J >= js-1) .and. (J <= je)) then do i = max(is-1,OBC%segment(n)%HI%isd), min(ie+1,OBC%segment(n)%HI%ied) - if (OBC%segment(n)%direction == OBC_DIRECTION_N) D_v(i,J) = G%bathyT(i,j) - if (OBC%segment(n)%direction == OBC_DIRECTION_S) D_v(i,J) = G%bathyT(i,j+1) + if (OBC%segment(n)%direction == OBC_DIRECTION_N) D_v(i,J) = G%bathyT(i,j) + G%Z_ref + if (OBC%segment(n)%direction == OBC_DIRECTION_S) D_v(i,J) = G%bathyT(i,j+1) + G%Z_ref enddo elseif (OBC%segment(n)%is_E_or_W .and. (I >= is-1) .and. (I <= ie)) then do j = max(js-1,OBC%segment(n)%HI%jsd), min(je+1,OBC%segment(n)%HI%jed) - if (OBC%segment(n)%direction == OBC_DIRECTION_E) D_u(I,j) = G%bathyT(i,j) - if (OBC%segment(n)%direction == OBC_DIRECTION_W) D_u(I,j) = G%bathyT(i+1,j) + if (OBC%segment(n)%direction == OBC_DIRECTION_E) D_u(I,j) = G%bathyT(i,j) + G%Z_ref + if (OBC%segment(n)%direction == OBC_DIRECTION_W) D_u(I,j) = G%bathyT(i+1,j) + G%Z_ref enddo endif enddo ; endif @@ -809,6 +735,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The drag within the bottommost bbl_thick is applied as a part of ! an enhanced bottom viscosity, while above this the drag is applied ! directly to the layers in question as a Rayleigh drag term. + + !### The harmonic mean edge depths here are not invariant to offsets! if (m==1) then D_vel = D_u(I,j) tmp = G%mask2dCu(I,j+1) * D_u(I,j+1) @@ -2217,12 +2145,12 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif if (CS%bottomdraglaw) then - allocate(visc%bbl_thick_u(IsdB:IedB,jsd:jed)) ; visc%bbl_thick_u(:,:) = 0.0 - allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed)) ; visc%kv_bbl_u(:,:) = 0.0 - allocate(visc%bbl_thick_v(isd:ied,JsdB:JedB)) ; visc%bbl_thick_v(:,:) = 0.0 - allocate(visc%kv_bbl_v(isd:ied,JsdB:JedB)) ; visc%kv_bbl_v(:,:) = 0.0 - allocate(visc%ustar_bbl(isd:ied,jsd:jed)) ; visc%ustar_bbl(:,:) = 0.0 - allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl(:,:) = 0.0 + allocate(visc%bbl_thick_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(visc%bbl_thick_v(isd:ied,JsdB:JedB), source=0.0) + allocate(visc%kv_bbl_v(isd:ied,JsdB:JedB), source=0.0) + allocate(visc%ustar_bbl(isd:ied,jsd:jed), source=0.0) + allocate(visc%TKE_bbl(isd:ied,jsd:jed), source=0.0) 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) @@ -2231,7 +2159,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_u = register_diag_field('ocean_model', 'bbl_u', diag%axesCu1, & Time, 'BBL mean u current', 'm s-1', conversion=US%L_T_to_m_s) if (CS%id_bbl_u>0) then - allocate(CS%bbl_u(IsdB:IedB,jsd:jed)) ; CS%bbl_u(:,:) = 0.0 + allocate(CS%bbl_u(IsdB:IedB,jsd:jed), source=0.0) endif 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) @@ -2240,10 +2168,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_v = register_diag_field('ocean_model', 'bbl_v', diag%axesCv1, & Time, 'BBL mean v current', 'm s-1', conversion=US%L_T_to_m_s) if (CS%id_bbl_v>0) then - allocate(CS%bbl_v(isd:ied,JsdB:JedB)) ; CS%bbl_v(:,:) = 0.0 + allocate(CS%bbl_v(isd:ied,JsdB:JedB), source=0.0) endif if (CS%BBL_use_tidal_bg) then - allocate(CS%tideamp(isd:ied,jsd:jed)) ; CS%tideamp(:,:) = 0.0 + allocate(CS%tideamp(isd:ied,jsd:jed), source=0.0) filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) @@ -2251,8 +2179,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif 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 + allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz), source=0.0) CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & @@ -2261,8 +2189,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%dynamic_viscous_ML) then - allocate(visc%nkml_visc_u(IsdB:IedB,jsd:jed)) ; visc%nkml_visc_u(:,:) = 0.0 - allocate(visc%nkml_visc_v(isd:ied,JsdB:JedB)) ; visc%nkml_visc_v(:,:) = 0.0 + allocate(visc%nkml_visc_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(visc%nkml_visc_v(isd:ied,JsdB:JedB), source=0.0) CS%id_nkml_visc_u = register_diag_field('ocean_model', 'nkml_visc_u', & diag%axesCu1, Time, 'Number of layers in viscous mixed layer at u points', 'm') CS%id_nkml_visc_v = register_diag_field('ocean_model', 'nkml_visc_v', & diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 25b5406449..2699e57099 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -147,9 +147,9 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 - allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 - allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 + allocate(CS%Iresttime_col(CS%num_col), source=0.0) + allocate(CS%col_i(CS%num_col), source=0) + allocate(CS%col_j(CS%num_col), source=0) col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -168,8 +168,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & endif if (CS%do_i_mean_sponge) then - allocate(CS%Iresttime_im(G%jsd:G%jed)) ; CS%Iresttime_im(:) = 0.0 - allocate(CS%Ref_eta_im(G%jsd:G%jed,GV%ke+1)) ; CS%Ref_eta_im(:,:) = 0.0 + allocate(CS%Iresttime_im(G%jsd:G%jed), source=0.0) + allocate(CS%Ref_eta_im(G%jsd:G%jed,GV%ke+1), source=0.0) do j=G%jsc,G%jec CS%Iresttime_im(j) = Iresttime_i_mean(j) @@ -238,8 +238,7 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) call MOM_error(FATAL,"set_up_sponge_field: "//mesg) endif - allocate(CS%Ref_val(CS%fldno)%p(CS%nz,CS%num_col)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 + allocate(CS%Ref_val(CS%fldno)%p(CS%nz,CS%num_col), source=0.0) do col=1,CS%num_col do k=1,nlay CS%Ref_val(CS%fldno)%p(k,col) = sp_val(CS%col_i(col),CS%col_j(col),k) @@ -262,8 +261,7 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 + allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz), source=0.0) do k=1,CS%nz ; do j=CS%jsc,CS%jec CS%Ref_val_im(CS%fldno)%p(j,k) = sp_val_i_mean(j,k) enddo ; enddo @@ -302,7 +300,7 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) endif CS%bulkmixedlayer = .true. - allocate(CS%Rcv_ml_ref(CS%num_col)) ; CS%Rcv_ml_ref(:) = 0.0 + allocate(CS%Rcv_ml_ref(CS%num_col), source=0.0) do col=1,CS%num_col CS%Rcv_ml_ref(col) = sp_val(CS%col_i(col),CS%col_j(col)) enddo @@ -311,7 +309,7 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed)) ; CS%Rcv_ml_ref_im(:) = 0.0 + allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed), source=0.0) do j=CS%jsc,CS%jec CS%Rcv_ml_ref_im(j) = sp_val_i_mean(j) enddo @@ -409,17 +407,17 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) enddo ; enddo ; enddo do j=js,je do i=is,ie - dilate(i) = G%bathyT(i,j) / (e_D(i,j,1) + G%bathyT(i,j)) + dilate(i) = (G%bathyT(i,j) + G%Z_ref) / (e_D(i,j,1) + G%bathyT(i,j)) enddo do k=1,nz+1 ; do i=is,ie - e_D(i,j,K) = dilate(i) * (e_D(i,j,K) + G%bathyT(i,j)) - G%bathyT(i,j) + e_D(i,j,K) = dilate(i) * (e_D(i,j,K) + G%bathyT(i,j)) - (G%bathyT(i,j) + G%Z_ref) enddo ; enddo enddo do k=2,nz do j=js,je ; do i=is,ie eta_anom(i,j) = e_D(i,j,k) - CS%Ref_eta_im(j,k) - if (CS%Ref_eta_im(j,K) < -G%bathyT(i,j)) eta_anom(i,j) = 0.0 + if (CS%Ref_eta_im(j,K) < -(G%bathyT(i,j) + G%Z_ref)) eta_anom(i,j) = 0.0 enddo ; enddo call global_i_mean(eta_anom(:,:), eta_mean_anom(:,K), G, tmp_scale=US%Z_to_m) enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 21562817c0..3b26d60451 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -484,16 +484,16 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 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 + if (G%bathyT(i,j)+G%Z_ref < 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 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))) + hamp = min(max_frac_rough*(G%bathyT(i,j)+G%Z_ref), 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)) + CS%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, CS%h2(i,j)) endif utide = CS%tideamp(i,j) @@ -1426,76 +1426,46 @@ subroutine setup_tidal_diagnostics(G, GV, CS) isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = GV%ke dd => CS%dd - if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) then - allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Kd_itidal(:,:,:) = 0.0 - endif - if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) then - allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Kd_lowmode(:,:,:) = 0.0 - endif - if ( (CS%id_Fl_itidal > 0) ) then - allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Fl_itidal(:,:,:) = 0.0 - endif - if ( (CS%id_Fl_lowmode > 0) ) then - allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Fl_lowmode(:,:,:) = 0.0 - endif - if ( (CS%id_Polzin_decay_scale > 0) ) then - allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed)) - dd%Polzin_decay_scale(:,:) = 0.0 - endif - if ( (CS%id_N2_bot > 0) ) then - allocate(dd%N2_bot(isd:ied,jsd:jed)) ; dd%N2_bot(:,:) = 0.0 - endif - if ( (CS%id_N2_meanz > 0) ) then - allocate(dd%N2_meanz(isd:ied,jsd:jed)) ; dd%N2_meanz(:,:) = 0.0 - endif - if ( (CS%id_Polzin_decay_scale_scaled > 0) ) then - allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) - dd%Polzin_decay_scale_scaled(:,:) = 0.0 - endif - if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) then - allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; dd%Kd_Niku(:,:,:) = 0.0 - endif - if (CS%id_Kd_Niku_work > 0) then - allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz)) ; dd%Kd_Niku_work(:,:,:) = 0.0 - endif - if (CS%id_Kd_Itidal_work > 0) then - allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz)) - dd%Kd_Itidal_work(:,:,:) = 0.0 - endif - if (CS%id_Kd_Lowmode_Work > 0) then - allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz)) - dd%Kd_Lowmode_Work(:,:,:) = 0.0 - endif - if (CS%id_TKE_itidal > 0) then - allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; dd%TKE_Itidal_used(:,:) = 0. - endif + if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) & + allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) & + allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_itidal > 0) allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_lowmode > 0) allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Polzin_decay_scale > 0) allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_bot > 0) allocate(dd%N2_bot(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_meanz > 0) allocate(dd%N2_meanz(isd:ied,jsd:jed), source=0.0) + if (CS%id_Polzin_decay_scale_scaled > 0) & + allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) + if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) & + allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_Niku_work > 0) allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Itidal_work > 0) allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Lowmode_Work > 0) allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_itidal > 0) allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) ! additional diags for CVMix - if (CS%id_N2_int > 0) then - allocate(dd%N2_int(isd:ied,jsd:jed,nz+1)) ; dd%N2_int(:,:,:) = 0.0 - endif + if (CS%id_N2_int > 0) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif - allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed)) ; dd%Simmons_coeff_2d(:,:) = 0.0 - endif - if (CS%id_vert_dep > 0) then - allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 + allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) endif + if (CS%id_vert_dep > 0) allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 + allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz)) ; dd%tidal_qe_md(:,:,:) = 0.0 + allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) endif end subroutine setup_tidal_diagnostics @@ -1678,7 +1648,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) CS%h_src(k) = US%Z_to_m*(z_t(k)-z_w(k))*2.0 ! form tidal_qe_3d_in from weighted tidal constituents do j=js,je ; do i=is,ie - if ((z_t(k) <= G%bathyT(i,j)) .and. (z_w(k) > CS%tidal_diss_lim_tc)) & + if ((z_t(k) <= G%bathyT(i,j) + G%Z_ref) .and. (z_w(k) > CS%tidal_diss_lim_tc)) & CS%tidal_qe_3d_in(i,j,k) = C1_3*tc_m2(i,j,k) + C1_3*tc_s2(i,j,k) + & tidal_qk1(i,j)*tc_k1(i,j,k) + tidal_qo1(i,j)*tc_o1(i,j,k) enddo ; enddo @@ -1692,7 +1662,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) ! do k=50,nz_in(1) ! write(1905,*) i,j,k ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! write(1905,*) z_t(k), G%bathyT(i,j)+G%Z_ref, z_w(k),CS%tidal_diss_lim_tc ! end do ! endif ! enddo @@ -1707,7 +1677,7 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d(:,:) = 0.0 !do k=1,nz_in(1) ; do j=js,je ; do i=is,ie - ! if (z_t(k) <= G%bathyT(i,j)) & + ! if (z_t(k) <= G%bathyT(i,j) + G%Z_ref) & ! CS%tidal_qe_2d(i,j) = CS%tidal_qe_2d(i,j) + CS%tidal_qe_3d_in(i,j,k) !enddo ; enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5b85c5f5f6..f9512d8c06 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -121,6 +121,7 @@ module MOM_vert_friction !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 + integer :: id_du_dt_str = -1, id_dv_dt_str = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_taux_bot = -1, id_tauy_bot = -1 integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 @@ -207,6 +208,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: stress ! The surface stress times the time step, divided ! by the density [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + real :: accel_underflow ! An acceleration magnitude that is so small that values that are less + ! than this are diagnosed as 0 [L T-2 ~> m s-2]. 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 [H L T-1 ~> m2 s-1 or kg m-1 s-1]. @@ -236,6 +239,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & h_neglect = GV%H_subroundoff Idt = 1.0 / dt + accel_underflow = CS%vel_underflow * Idt + !Check if Stokes mixing allowed if requested (present and associated) DoStokesMixing=.false. if (CS%StokesMixing) then @@ -265,9 +270,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%du_dt_visc(I,j,k) = u(I,j,k) enddo ; enddo ; endif -! One option is to have the wind stress applied as a body force -! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, -! the wind stress is applied as a stress boundary condition. + if (associated(ADp%du_dt_str)) then ; do k=1,nz ; do I=Isq,Ieq + ADp%du_dt_str(I,j,k) = 0.0 + enddo ; enddo ; endif + + ! One option is to have the wind stress applied as a body force + ! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, + ! the wind stress is applied as a stress boundary condition. if (CS%direct_stress) then do I=Isq,Ieq ; if (do_i(I)) then surface_stress(I) = 0.0 @@ -277,6 +286,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & h_a = 0.5 * (h(I,j,k) + h(I+1,j,k)) + h_neglect hfr = 1.0 ; if ((zDS+h_a) > Hmix) hfr = (Hmix - zDS) / h_a u(I,j,k) = u(I,j,k) + I_Hmix * hfr * stress + if (associated(ADp%du_dt_str)) ADp%du_dt_str(i,J,k) = (I_Hmix * hfr * stress) * Idt zDS = zDS + h_a ; if (zDS >= Hmix) exit enddo endif ; enddo ! end of i loop @@ -316,6 +326,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I)) + if (associated(ADp%du_dt_str)) & + ADp%du_dt_str(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_str(I,j,1) + surface_stress(I)*Idt) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I) @@ -324,6 +336,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & d1(I) = b_denom_1 * b1(I) u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + & dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) + if (associated(ADp%du_dt_str)) & + ADp%du_dt_str(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_str(I,j,k) + & + dt_Z_to_H * CS%a_u(I,j,K) * ADp%du_dt_str(I,j,k-1)) * b1(I) endif ; enddo ; enddo ! back substitute to solve for the new velocities @@ -332,8 +347,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & u(I,j,k) = u(I,j,k) + c1(I,k+1) * u(I,j,k+1) endif ; enddo ; enddo ! i and k loops + if (associated(ADp%du_dt_str)) then + do i=is,ie ; if (abs(ADp%du_dt_str(I,j,nz)) < accel_underflow) ADp%du_dt_str(I,j,nz) = 0.0 ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_str(I,j,k) = ADp%du_dt_str(I,j,k) + c1(I,k+1) * ADp%du_dt_str(I,j,k+1) + if (abs(ADp%du_dt_str(I,j,k)) < accel_underflow) ADp%du_dt_str(I,j,k) = 0.0 + endif ; enddo ; enddo + endif + if (associated(ADp%du_dt_visc)) then ; do k=1,nz ; do I=Isq,Ieq ADp%du_dt_visc(I,j,k) = (u(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + if (abs(ADp%du_dt_visc(I,j,k)) < accel_underflow) ADp%du_dt_visc(I,j,k) = 0.0 enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq @@ -373,9 +397,13 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ADp%dv_dt_visc(i,J,k) = v(i,J,k) enddo ; enddo ; endif -! One option is to have the wind stress applied as a body force -! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, -! the wind stress is applied as a stress boundary condition. + if (associated(ADp%dv_dt_str)) then ; do k=1,nz ; do i=is,ie + ADp%dv_dt_str(i,J,k) = 0.0 + enddo ; enddo ; endif + + ! One option is to have the wind stress applied as a body force + ! over the topmost Hmix fluid. If DIRECT_STRESS is not defined, + ! the wind stress is applied as a stress boundary condition. if (CS%direct_stress) then do i=is,ie ; if (do_i(i)) then surface_stress(i) = 0.0 @@ -385,6 +413,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & h_a = 0.5 * (h(i,J,k) + h(i,J+1,k)) + h_neglect hfr = 1.0 ; if ((zDS+h_a) > Hmix) hfr = (Hmix - zDS) / h_a v(i,J,k) = v(i,J,k) + I_Hmix * hfr * stress + if (associated(ADp%dv_dt_str)) ADp%dv_dt_str(i,J,k) = (I_Hmix * hfr * stress) * Idt zDS = zDS + h_a ; if (zDS >= Hmix) exit enddo endif ; enddo ! end of i loop @@ -401,6 +430,8 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i)) + if (associated(ADp%dv_dt_str)) & + ADp%dv_dt_str(i,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_str(i,J,1) + surface_stress(i)*Idt) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i) @@ -408,13 +439,25 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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) + if (associated(ADp%dv_dt_str)) & + ADp%dv_dt_str(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_str(i,J,k) + & + dt_Z_to_H * CS%a_v(i,J,K) * ADp%dv_dt_str(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) endif ; enddo ; enddo ! i and k loops + if (associated(ADp%dv_dt_str)) then + do i=is,ie ; if (abs(ADp%dv_dt_str(i,J,nz)) < accel_underflow) ADp%dv_dt_str(i,J,nz) = 0.0 ; enddo + do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_str(i,J,k) = ADp%dv_dt_str(i,J,k) + c1(i,k+1) * ADp%dv_dt_str(i,J,k+1) + if (abs(ADp%dv_dt_str(i,J,k)) < accel_underflow) ADp%dv_dt_str(i,J,k) = 0.0 + endif ; enddo ; enddo + endif + if (associated(ADp%dv_dt_visc)) then ; do k=1,nz ; do i=is,ie ADp%dv_dt_visc(i,J,k) = (v(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + if (abs(ADp%dv_dt_visc(i,J,k)) < accel_underflow) ADp%dv_dt_visc(i,J,k) = 0.0 enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie @@ -458,7 +501,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo endif -! Offer diagnostic fields for averaging. + ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) if (CS%id_dv_dt_visc > 0) & @@ -467,6 +510,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & call post_data(CS%id_taux_bot, taux_bot, CS%diag) if (present(tauy_bot) .and. (CS%id_tauy_bot > 0)) & call post_data(CS%id_tauy_bot, tauy_bot, CS%diag) + if (CS%id_du_dt_str > 0) & + call post_data(CS%id_du_dt_str, ADp%du_dt_str, CS%diag) + if (CS%id_dv_dt_str > 0) & + call post_data(CS%id_dv_dt_str, ADp%dv_dt_str, CS%diag) ! Diagnostics for terms multiplied by fractional thicknesses @@ -485,8 +532,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! call post_data(CS%id_hf_dv_dt_visc, CS%hf_dv_dt_visc, CS%diag) !endif if (CS%id_hf_du_dt_visc_2d > 0) then - allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_du_dt_visc_2d(:,:) = 0.0 + allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_du_dt_visc_2d(I,j) = hf_du_dt_visc_2d(I,j) + ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -494,8 +540,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & deallocate(hf_du_dt_visc_2d) endif if (CS%id_hf_dv_dt_visc_2d > 0) then - allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dv_dt_visc_2d(:,:) = 0.0 + allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_dv_dt_visc_2d(i,J) = hf_dv_dt_visc_2d(i,J) + ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -504,8 +549,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif if (CS%id_h_du_dt_visc > 0) then - allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt_visc(:,:,:) = 0.0 + allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -513,8 +557,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & deallocate(h_du_dt_visc) endif if (CS%id_h_dv_dt_visc > 0) then - allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt_visc(:,:,:) = 0.0 + allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -524,10 +567,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & end subroutine vertvisc -!> Calculate the fraction of momentum originally in a layer that remains -!! 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. +!> Calculate the fraction of momentum originally in a layer that remains in the water column +!! after a time-step of viscosity, equivalently 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, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -566,10 +608,8 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo - ! Find the zonal viscous using a modification of a standard tridagonal solver. -!$OMP parallel do default(none) shared(G,Isq,Ieq,CS,nz,visc,dt_Z_to_H,visc_rem_u) & -!$OMP firstprivate(Ray) & -!$OMP private(do_i,b_denom_1,b1,d1,c1) + ! Find the zonal viscous remnant using a modification of a standard tridagonal solver. + !$OMP parallel do default(shared) firstprivate(Ray) private(do_i,b_denom_1,b1,d1,c1) do j=G%jsc,G%jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo @@ -597,10 +637,8 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) enddo ! end u-component j loop - ! Now find the meridional viscous using a modification. -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,G,CS,visc,dt_Z_to_H,visc_rem_v,nz) & -!$OMP firstprivate(Ray) & -!$OMP private(do_i,b_denom_1,b1,d1,c1) + ! Now find the meridional viscous remnant using the robust tridiagonal solver. + !$OMP parallel do default(shared) firstprivate(Ray) private(do_i,b_denom_1,b1,d1,c1) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo @@ -723,28 +761,20 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val - if (CS%id_Kv_u > 0) then - allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ; Kv_u(:,:,:) = 0.0 - endif + if (CS%id_Kv_u > 0) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - if (CS%id_Kv_v > 0) then - allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ; Kv_v(:,:,:) = 0.0 - endif + if (CS%id_Kv_v > 0) allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - if (CS%debug .or. (CS%id_hML_u > 0)) then - allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; hML_u(:,:) = 0.0 - endif - if (CS%debug .or. (CS%id_hML_v > 0)) then - allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB)) ; hML_v(:,:) = 0.0 - endif + if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) + if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) if ((associated(visc%taux_shelf) .or. associated(forces%frac_shelf_u)) .and. & .not.associated(CS%a1_shelf_u)) then - allocate(CS%a1_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; CS%a1_shelf_u(:,:)=0.0 + allocate(CS%a1_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) endif if ((associated(visc%tauy_shelf) .or. associated(forces%frac_shelf_v)) .and. & .not.associated(CS%a1_shelf_v)) then - allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 + allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) endif !$OMP parallel do default(private) shared(G,GV,US,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & @@ -1813,13 +1843,20 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', & thickness_units, conversion=GV%H_to_MKS) - CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, 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', conversion=US%L_T2_to_m_s2) + CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, 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_du_dt_str = register_diag_field('ocean_model', 'du_dt_str', diag%axesCuL, Time, & + 'Zonal Acceleration from Surface Wind Stresses', 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_du_dt_str > 0) call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) + CS%id_dv_dt_str = register_diag_field('ocean_model', 'dv_dt_str', diag%axesCvL, Time, & + 'Meridional Acceleration from Surface Wind Stresses', 'm s-2', conversion=US%L_T2_to_m_s2) + if (CS%id_dv_dt_str > 0) call safe_alloc_ptr(ADp%dv_dt_str,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%RZ_to_kg_m2*US%L_T2_to_m_s2) diff --git a/src/parameterizations/vertical/_Frazil.dox b/src/parameterizations/vertical/_Frazil.dox new file mode 100644 index 0000000000..06321231a3 --- /dev/null +++ b/src/parameterizations/vertical/_Frazil.dox @@ -0,0 +1,33 @@ +/*! \page Frazil_Ice Frazil Ice Formation + +\section section_frazil Frazil Ice Formation + +Frazil ice forms in the model when the in situ temperature drops below +the local freezing point, taking into account the in situ salinity and +pressure. Starting at the bottom and working up through the water column, +if the water is below freezing, set it to freezing and add the heat +required to the heat deficit. If the water above is warmer than freezing, +use that heat to take away the heat deficit and to cool the water. If +you get all the way to the surface with a heat deficit, that quantity +is passed to the ice model as a heat flux it will need to provide to +the ocean. + +The local freezing point code is provided by the equation of state being +used by MOM6. See \ref section_TFREEZE for the MOM6 options. + +The salinity is adjusted only at the surface when frazil ice is +formed. This happens when the ice model creates ice with the heat deficit, +taking salt out of the surface waters. We inherit this behavior from +older versions of MOM, but the effect of not adjusting the in situ +salinity is thought to be small. + +Note that versions simply whisking all the heat deficit to the surface +without checking for warm water above tended to produce rapidly-melting +ice floes in warm waters. This was deemed unphysical and was corrected. + +A similar process that we are also omitting is the formation of salt +crystals when the salinity becomes too high. The salt crystals should +form and sink, leaving a layer on the bed that will be diluted when the +salinity drops again. This process can be seen in a lake in Death Valley. + +*/ diff --git a/src/parameterizations/vertical/_V_diffusivity.dox b/src/parameterizations/vertical/_V_diffusivity.dox new file mode 100644 index 0000000000..8c4c8ce7aa --- /dev/null +++ b/src/parameterizations/vertical/_V_diffusivity.dox @@ -0,0 +1,610 @@ +/*! \page Internal_Vert_Mixing Internal Vertical Mixing + +Sets the interior vertical diffusion of scalars due to the following processes: + +-# Shear-driven mixing (\ref section_Shear): \cite jackson2008 or KPP interior; +-# Background mixing (\ref section_Background): via CVMix (Bryan-Lewis profile), + the scheme described by \cite harrison2008, or that in \cite danabasoglu2012. +-# Double-diffusion (\ref section_Double_Diff): old method or new method via CVMix; +-# Tidal mixing: many options available, see \ref section_Internal_Tidal_Mixing. + +In addition, the MOM_set_diffusivity has the option to set the interior vertical +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 + +The resulting diffusivity, \f$K_d\f$, is the sum of all the contributions +unless you set BBL_MIXING_AS_MAX to True, in which case the maximum of +all the contributions is used. + +In addition, \f$K_d\f$ is multiplied by the term: + +\f[ + \frac{N^2}{N^2 + \Omega^2} +\f] + +where \f$N\f$ is the buoyancy frequency and \f$\Omega\f$ is the angular velocity +of the Earth. This allows the buoyancy fluxes to tend to zero in regions +of very weak stratification, allowing a no-flux bottom boundary condition +to be satisfied. + +\section section_Shear Shear-driven Mixing + +Below the surface mixed layer, there are places in the world's oceans +where shear mixing is known to take place. This shear-driven mixing can +be represented in MOM6 through either CVMix or the parameterization of +\cite jackson2008. + +\subsection subsection_CVMix_shear Shear-driven mixing in CVMix + +The community vertical mixing (CVMix) code contains options for shear +mixing from either \cite large1994 or from \cite pacanowski1981. In MOM6, +CVMix is included via a git submodule which loads the external CVMix +package. The shear mixing routine in CVMix was developed to reproduce the +observed mixing of the equatorial undercurrent in the Pacific. + +We first compute the gradient Richardson number \f$\mbox{Ri} = N^2 / S^2\f$, +where \f$S\f$ is the vertical shear (\f$S = ||\bf{u}_z ||\f$) and \f$N\f$ +is the buoyancy frequency (\f$N^2 = -g \rho_z / \rho_0\f$). The +parameterization of \cite large1994 is as follows, where the diffusivity \f$\kappa\f$ +is given by + +\f[ + \kappa = \kappa_0 \left[ 1 - \min \left( 1, \frac{\mbox{Ri}}{\mbox{Ri}_c} \right) + ^2 \right] ^3 , +\f] + +with \f$\kappa_0 = 5 \times 10^{-3}\, \mbox{m}^2 \,\mbox{s}^{-1}\f$ and \f$\mbox{Ri}_c = 0.7\f$. + +One can instead select the \cite pacanowski1981 scheme within CVMix. Unlike +the \cite large1994 scheme, they propose that the vertical shear +viscosity \f$\nu_{\mbox{shear}}\f$ be different from the vertical shear +diffusivity \f$\kappa_{\mbox{shear}}\f$. For gravitationally stable +profiles (i.e., \f$N^2 > 0\f$), they chose + +\f[ + \nu_{\mbox{shear}} = \frac{\nu_0}{(1 + a \mbox{Ri})^n} +\f] + +\f[ + \kappa_{\mbox{shear}} = \frac{\nu_0}{(1 + a \mbox{Ri})^{n+1}} +\f] + +where \f$\nu_0\f$, \f$a\f$ and \f$n\f$ are adjustable parameters. Common settings are \f$a = 5\f$ +and \f$n = 2\f$. + +For both CVMix shear mixing schemes, the mixing coefficients are set to +a large value for gravitationally unstable profiles. + +\subsection subsection_kappa_shear Shear-driven mixing in Jackson + +While the above parameterization works well enough in the equatorial +Pacific, another place one can expect shear-mixing to matter is +in overflows of dense water. \cite jackson2008 proposes a new shear +parameterization with the goal of working in both the equatorial undercurrent +and for overflows, also to have smooth transitions between unstable and +stable regions. Their scheme looks like: + +\f{eqnarray} + \frac{\partial^2 \kappa}{\partial z^2} - \frac{\kappa}{L^2_d} &= - 2 SF(\mbox{Ri}) . + \label{eq:Jackson_10} +\f} + +This is similar to the locally constant stratification limit of +\cite turner1986, but with the addition of a decay length scale +\f$L_d = \lambda L_b\f$. Here \f$L_b = Q^{1/2} / N\f$ is the buoyancy +length scale where \f$Q\f$ is the turbulent kinetic energy (TKE) per +unit mass, and \f$\lambda\f$ is a nondimensional constant. The function +\f$F(\mbox{Ri})\f$ is a function of the Richardson number that remains +to be determined. As in \cite turner1986, there must be a critical +value of \f$\mbox{Ri}\f$ above which \f$F(\mbox{Ri}) = 0\f$. +For better agreement with observations in a law-of-the-wall configuration, +we modify \f$L_d\f$ to be \f$\min (\lambda L_b, L_z)\f$, where \f$L_z\f$ +is the distance to the nearest solid boundary. This can be understood by +considering \f$L_d\f$ to be the size of the largest turbulent eddies, +whether they are constrained by the stratification (through \f$L_b\f$) +or through the geometry (through \f$L_z\f$). + +There are two length scales: the width of the low Richardson number region +as in \cite turner1986, and the buoyancy length scale, which is the +length scale over which the TKE is affected by the stratification (see +\cite jackson2008 for more details). In particular, the inclusion of a +decay length scale means that the diffusivity decays exponentially away +from the mixing region with a length scale of \f$L_d\f$. This is important +since turbulent eddies generated in the low \f$\mbox{Ri}\f$ layer can +be vertically self-advected and mix nearby regions. This method yields +a smoother diffusivity than that in \cite hallberg2000, especially in +areas where the Richardson number is noisy. + +This parameterization predicts the turbulent eddy diffusivity in terms +of the vertical profiles of velocity and density, providing that the +TKE is known. To complete the parameterization we use a TKE \f$Q\f$ +budget such as that used in second-order turbulence closure models +(\cite umlauf2005). We make a few additional assumptions, however, +and use the simplified form + +\f{eqnarray} + \frac{\partial}{\partial z} \left[ (\kappa + \nu_0) \frac{\partial Q} + {\partial z} \right] + \kappa (S^2 - N^2) - Q(c_N N + c_S S) &= 0. + \label{eq:Jackson_11} +\f} + +The system is therefore in balance between a vertical diffusion of +TKE caused by both the eddy and molecular viscosity \f$(\nu_0)\f$, +the production of TKE by shear, a sink due to stratification, and the +dissipation. Note that we are assuming a Prandtl number of 1, although a +parameterization for the Prandtl number could be added. We have assumed +that the TKE reaches a quasi-steady state faster than the flow is evolving +and faster than it can be affected by mean-flow advection so that \f$DQ/Dt = +0\f$. Since this parameterization is meant to be used in climate models +with low horizontal resolution and large time steps compared to the +mixing time scales, this is a reasonable assumption. The most tenuous +assumption is in the form of the dissipation \f$\epsilon = Q(C_N N + +c_S S)\f$ (where \f$c_N\f$ and \f$c_S\f$ are to be determined), +which is assumed to be dependent on the buoyancy frequency (through loss +of energy to internal waves) and the velocity shear (through the energy +cascade to smaller scales). + +We can rewrite \eqref{eq:Jackson_10} as the steady "transport" equation +for the turbulent diffusivity (i.e., with \f$D\kappa/Dt = 0\f$), + +\f[ + \frac{\partial}{\partial z} \left( \kappa \frac{\partial \kappa}{\partial z} + \right) + 2\kappa SF(\mbox{Ri}) - \left( \frac{\kappa}{L_d} \right)^2 - + \left( \frac{\partial \kappa}{\partial z} \right) ^2 = 0 . +\f] + +The first term on the left can be regarded as a vertical transport of +diffusivity, the second term as a source, and the final two as sinks. +This equation with \eqref{eq:Jackson_11} are simple enough to solve quickly +using an iterative technique. + +We also need boundary conditions for \eqref{eq:Jackson_10} +and \eqref{eq:Jackson_11}. For the turbulent diffusivity we use +\f$\kappa = 0\f$ since our diffusivity is numerically defined on +layer interfaces. This ensures that there is no turbulent flux across +boundaries. For the TKE we use boundary conditions of \f$Q = Q_0\f$ where +\f$Q_0\f$ is a constant value of TKE, used to prevent a singularity +in \eqref{eq:Jackson_10}, that is chosen to be small enough to not +influence results. Note that the value of \f$\kappa\f$ calculated here +reflects shear-driven turbulent mixing only; the total diffusivity would +be this value plus any diffusivities due to other turbulent processes +or a background value. + +Based on \cite turner1986, we choose \f$F(\mbox{Ri})\f$ of the form + +\f[ + F(\mbox{Ri}) = F_0 \left( \frac{1 - \mbox{Ri} / \mbox{Ri}_c} + {1 + \alpha \mbox{Ri} / \mbox{Ri}_c} \right) , +\f] + +where \f$\alpha\f$ is the curvature parameter. This table shows the default +values of the relevant parameters: + + + +
Shear mixing parameters
Parameter Default value MOM6 parameter +
\f$\mbox{Ri}_c\f$ 0.25 RINO_CRIT +
\f$\nu_0\f$ \f$1.5 \times 10^{-5}\f$ KD_KAPPA_SHEAR_0 +
\f$F_0\f$ 0.089 SHEARMIX_RATE +
\f$\alpha\f$ -0.97 FRI_CURVATURE +
\f$\lambda\f$ 0.82 KAPPA_BUOY_SCALE_COEF +
\f$c_N\f$ 0.24 TKE_N_DECAY_CONST +
\f$c_S\f$ 0.14 TKE_SHEAR_DECAY_CONST +
+ +These can all be adjusted at run time, plus some other parameters such as the maximum number of iterations +to perform. + +\section section_Background Background Mixing + +There are three choices for the vertical background mixing: that in +CVMix (\cite bryan1979), that in \cite harrison2008, and that in +\cite danabasoglu2012. + +\subsection subsection_bryan_lewis CVMix background mixing + +The background vertical mixing in \cite bryan1979 is of the form: + +\f[ + \kappa = C_1 + C_2 \mbox{atan} [ C_3 ( |z| - C_4 )] +\f] + +where the constants are runtime parameters as shown here: + + + +
Bryan Lewis parameters
Parameter Units MOM6 parameter +
\f$C_1\f$ m2 s-1 BRYAN_LEWIS_C1 +
\f$C_2\f$ m2 s-1 BRYAN_LEWIS_C2 +
\f$C_3\f$ m-1 BRYAN_LEWIS_C3 +
\f$C_4\f$ m BRYAN_LEWIS_C4 +
+ +\subsection subsection_henyey Henyey IGW background mixing + +\cite harrison2008 choose a vertical background mixing with a latitudinal +dependence based on \cite henyey1986. Specifically, theory predicts +a minimum in mixing due to wave-wave interactions at the equator and +observations support that theory. In this option, the surface background +diffusivity is + +\f[ + \kappa_s (\phi) = \max \left[ 10^{-7}, \kappa_0 \left| \frac{f}{f_{30}} \right| + \frac{ \cosh^{-1} (1/f) }{ \cosh^{-1} (1/f_{30})} \right] , +\f] + +where \f$f_{30}\f$ is the Coriolis frequency at \f$30^\circ\f$ latitude. The two-dimensional equation for +the diffusivity is + +\f[ + \kappa(\phi, z) = \kappa_s + \Gamma \mbox{atan} \left( \frac{H_t}{\delta_t} \right) + + \Gamma \mbox{atan} \left( \frac{z - H_t}{\delta_t} \right) , +\f] +\f[ + \Gamma = \frac{(\kappa_d - \kappa_s) }{\left[ 0.5 \pi + \mbox{atan} \left( \frac{H_t}{\delta_t} \right) + \right] }, +\f] + +where \f$H_t = 2500\, \mbox{m}\f$, \f$\delta_t = 222\, \mbox{m}\f$, and +\f$\kappa_d\f$ is the deep ocean diffusivity of \f$10^{-4}\, \mbox{m}^2 +\, \mbox{s}^{-1}\f$. Note that this is the vertical structure described +in \cite harrison2008, but that isn't what is in the MOM6 code. Instead, the surface +value is propagated down, with the assumption that the tidal mixing parameterization +will provide the deep mixing: \ref section_Internal_Tidal_Mixing. + +There is also a "new" Henyey version, taking into account the effect of stratification on +TKE dissipation, + +\todo Harrison (personal communication) recommends that this option be made obsolete and +eventually removed. + +\f[ + \epsilon = \epsilon_0 \frac{f}{f_0} \frac{\mbox{acosh} (N/f)}{\mbox{acosh} (N_0 / f_0)} +\f] + +where \f$N_0\f$ and \f$f_0\f$ are the reference buoyancy frequency and inertial frequencies, respectively +and \f$\epsilon_0\f$ is the reference dissipation at \f$(N_0, f_0)\f$. In the previous version, \f$N = +N_0\f$. Additionally, the relationship between diapycnal diffusivities and stratification is included: + +\f[ + \kappa = \frac{\epsilon}{N^2} +\f] +This approach assumes that work done against gravity is uniformly distributed throughout the water column. +The original version concentrates buoyancy work in regions of strong stratification. + +\subsection subsection_danabasoglu_back Danabasoglu background mixing + +The shape of the \cite danabasoglu2012 background mixing has a uniform background value, with a dip +at the equator and a bump at \f$\pm 30^{\circ}\f$ degrees latitude. The form is shown in this figure + +\image html background_varying.png "Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator." +\imagelatex{background_varying.png,Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} + +Some parameters of this curve are set in the input file, some are hard-coded in calculate_bkgnd_mixing. + +\section section_Double_Diff Double Diffusion + +From \cite large1994, \cite griffies2015a, double-diffusive mixing +can occur when the vertical gradient of density is stable but the +vertical gradient of either salinity or temperature is unstable in its +contribution to density. The key stratification parameter for double +diffusive processes is + +\f[ + R_\rho = \frac{\alpha}{\beta} \left( \frac{\partial \Theta / \partial z}{\partial S / + \partial z} \right) , +\f] + +where the thermal expansion coefficient is given by + +\f[ + \alpha = - \frac{1}{\rho} \left( \frac{\partial \rho}{\partial \Theta} \right) , +\f] + +and the haline contraction coefficient is + +\f[ + \beta = \frac{1}{\rho} \left( \frac{\partial \rho}{\partial S} \right) . +\f] + +Note that the effects from double diffusive processes on viscosity are not well known and +are ignored in MOM6. + +In MOM6, there are two choices for the implementation of double +diffusion. The older DOUBLE_DIFFUSION option, with reference to an +unknown tech report from NCAR, aims to match the scheme used in MOM4, an update on +\cite large1994. The newer option is to call the routines from CVMix (USE_CVMIX_DDIFF). + +There are two regimes of double diffusive processes, salt fingering and diffusive +convective, with differing parameterizations in the two regimes. + +\subsection subsection_salt_finger Salt fingering regime + +The salt fingering regime occurs when salinity is destabilizing the water column (salty, +above fresh water) and when the stratification parameter \f$R_\rho\f$ is within a +particular range: + +\f[ + \frac{\partial S}{\partial z} > 0 +\f] +\f[ + 1 < R_\rho < R_\rho^0. +\f] + +The value of the cutoff \f$R_\rho\f$ is 1.9 in the old code, 2.55 in CVMix. + +The form of the diffusivity for both is + +\f{eqnarray}{ + \kappa_d =& \kappa_d^0 \left[ 1 - \left( \frac{R_\rho - 1}{R_\rho^0 - 1} \right) + \right]^3 & \mbox{for } 1 < R_\rho < R_\rho^0 \\ + \kappa_d =& 0 & \mbox{otherwise.} +\f} + +The default values of \f$\kappa_d^0\f$ are + +\f{eqnarray}{ + \kappa_d^0 =& 1 \times 10^{-4} & \mbox{for salinity and other tracers} \\ + \kappa_d^0 =& 0.7 \times 10^{-4} & \mbox{for temperature.} +\f} + +Note that the form in \cite large1994 is slightly different. + +\subsection subsection_diffusive_convective Diffusive convective regime + +Both implementations of the diffusive convective double diffusion have the same form +(\cite large1994) and are active when + +\f[ + \frac{\partial \Theta}{\partial z} < 0 +\f] +\f[ + 0 < R_\rho < 1. +\f] + +For temperature, the vertical diffusivity is given by + +\f[ + \kappa_d = \nu_\mbox{molecular} \times 0.909 \exp \left( 4.6 \exp \left[ -.54 + \left( R_\rho^{-1} - 1 \right) \right] \right) , +\f] + +where + +\f[ + \nu_\mbox{molecular} = 1.5 \times 10^{-6} \mbox{m}^2 \mbox{s}^{-1} +\f] + +is the molecular viscosity of water. Multiplying the diffusivity by the Prandtl number +\f$Pr\f$ + +\f{eqnarray}{ + Pr = \left\{ \begin{matrix} (1.85 - 0.85 R_\rho^{-1} ) R_\rho & 0.5 \leq R_\rho < 1 \\ + 0.15 R_\rho & R_\rho < 0.5 , \end{matrix} \right. +\f} + +gives the diffusivity for salinity and other tracers. + +\section section_Internal_Tidal_Mixing Internal Tidal Mixing + +Two parameterizations of vertical mixing due to internal tides are +available with the option INT_TIDE_DISSIPATION. The first is that of +\cite st_laurent2002 while the second is that of \cite polzin2009. Choose +between them with the INT_TIDE_PROFILE option. There are other relevant +parameters which can be seen in MOM_parameter_doc.all once the main tidal +dissipation switch is turned on. + +\subsection subsection_st_laurent St Laurent et al. + +The estimated turbulent dissipation rate of +internal tide energy \f$\epsilon\f$ is: + +\f[ + \epsilon = \frac{q E(x,y)}{\rho} F(z). +\f] + +where \f$\rho\f$ is the reference density of seawater, \f$E(x,y)\f$ is +the energy flux per unit area transferred from barotropic to baroclinic +tides, \f$q\f$ is the fraction of the internal-tide energy dissipated +locally, and \f$F(z)\f$ is the vertical structure of the dissipation. +This \f$q\f$ is estimated to be roughly 0.3 based on observations. The +term \f$E(x,y)\f$ is given by \cite st_laurent2002 as: + +\f[ + E(x,y) \simeq \frac{1}{2} \rho N_b \kappa h^2 \langle U^2 \rangle +\f] + +where \f$\rho\f$ is the reference density of seawater, \f$N_b\f$ is +the buoyancy frequency along the seafloor, and \f$(\kappa, h)\f$ are +the wavenumber and amplitude scales for the topographic roughness, and +\f$\langle U^2 \rangle\f$ is the barotropic tide variance. It is assumed +that the model will read in topographic roughness squared \f$h^2\f$ +from a file (the variable must be named "h2"). + +To convert from energy dissipation to vertical diffusion \f$K_d\f$, +the simple estimate is: + +\f[ + K_d \approx \frac{\Gamma q E(x,y) F(z)}{\rho N^2} +\f] + +where \f$\Gamma\f$ is the mixing efficiency, generally set to 0.2 +and \f$F(z)\f$ is a vertical structure function with exponential decay +from the bottom: + +\f[ + F(z) = \frac{e^{-(H+z)/\zeta}}{\zeta (1 - e^{H/\zeta}}. +\f] + +Here, \f$\zeta\f$ is a vertical decay scale with a default of 500 meters. +One change in MOM6 from the St. Laurent scheme is to use this form of \f$\Gamma\f$: + +\f[ + \Gamma = 0.2 \frac{N^2}{N^2 + \Omega^2} +\f] + +instead of \f$\Gamma = 0.2\f$, where \f$\Omega\f$ is the angular velocity +of the Earth. This allows the buoyancy fluxes to tend to zero in regions +of very weak stratification, allowing a no-flux bottom boundary condition +to be satisfied. + +\subsection subsection_polzin Polzin + +The vertical diffusion profile of \cite polzin2009 is a WKB-stretched +algebraic decay profile. It is based on a radiation balance equation, +which links the dissipation profile associated with internal breaking to +the finescale internal wave shear producing that dissipation. The vertical +profile of internal-tide driven energy dissipation can then vary in time +and space, and evolve in a changing climate (\cite melet2012). \cite melet2012 +describes how the Polzin scheme is implemented in MOM6, +copied here. + +The parameterization of \cite polzin2009 links the energy dissipation +profile to the finescale internal wave shear producing that +dissipation, using an idealized vertical wavenumber energy spectrum +to identify analytic solutions to a radiation balance equation +(\cite polzin2004). These solutions yield a dissipation profile +\f$\epsilon(z)\f$: + +\f[ + \epsilon = \frac{\epsilon_0}{[1 + (z/z_p)]^2}, +\f] + +where the magnitude \f$\epsilon_0\f$ and scale height \f$z_p\f$ can be expressed in terms of the +spectral amplitude and bandwidth of the idealized vertical wavenumber energy spectrum in uniform +stratification (\cite polzin2009). + +To take into account the nonuniform stratification, \cite polzin2009 applied a buoyancy scaling +using the Wentzel-Kramers-Brillouin (WKB) approximation. As a result, the vertical wavenumber of a +wave packet varies in proportion to the buoyancy frequency \f$N\f$, which in turn implies an +additional transport of energy to smaller scales, and thus a possible enhanced mixing in regions of +strong stratification. Such effects can be described by buoyancy scaling the vertical coordinate +\f$z\f$ as + +\f[ + z^{\ast}(z) = \int_{0}^{z} \left[ \frac{N^2 (z^\prime )}{N_b^2} \right] dz^{\prime} , +\f] + +with \f$z^\prime\f$ being positive upward relative to the bottom of the ocean. The turbulent +dissipation rate then becomes + +\f[ + \epsilon = \frac{\epsilon_0}{[1 + (z^{\ast} /z_p)]^2} \frac{N^2(z)}{N_b^2} . +\f] + +The spectral amplitude and bandwidth of the idealized vertical wavenumber +energy spectrum are identified after WKB scaling using a quasi-linear +spectral model of internal-tide generation that incorporates horizontal +advection of the barotropic tide into the momentum equation (\cite bell1975). +As a result, Polzin's formulation leads to an expression for +the spatially and temporally varying dissipation of internal tide energy +at the bottom \f$\epsilon_0\f$, and the vertical scale of decay for the +dissipation of internal tide energy \f$z_p\f$. + +\subsubsection subsection_energy_conserving Energy-conserving form + +To satisfy energy conservation (the integral of the vertical structure for the turbulent dissipation +over depth should be unity), the dissipation is rewritten as + +\f[ + \epsilon = \frac{\epsilon_0 z_p}{1 + (z^\ast/z_p)]^2} \frac{N^2(z)}{N^2_b} \left[ + \frac{1}{z^{\ast(z=H)}} + \frac{1}{z_p} \right] . +\f] + +In the MOM6 implementation, we use the \cite st_laurent2002 template for the vertical flux of energy +at the ocean floor, so that in both formulations: + +\f[ + \int_{0}^{H} \epsilon (z) dz = \frac{qE}{\rho} . +\f] + +Whereas \cite polzin2009 assumed that the total dissipation was locally in balance with the +barotropic to baroclinic energy conversion rate \f$(q=1)\f$, here we use the \cite simmons2004 value +of \f$q=1/3\f$ to retain as much consistency as possible between both parameterizations. + +\subsubsection subsection_vertical_decay_scale Vertical decay-scale reformulation + +We follow the \cite polzin2009 prescription for the vertical scale of +decay for the dissipation of internal-tide energy. However, we assume +that the topographic power law, denoted as \f$\nu\f$ in \cite polzin2009, +is equal to 1 (instead of 0.9) and we reformulated the expression of +\f$z_p\f$ to put it in a more readable form: + +\f[ + z_p = \frac{z_p^\mbox{ref} (\kappa^\mbox{ref})^2 (h^\mbox{ref})^2 (N_b^\mbox{ref})^3} {U^\mbox{ref}} + \frac{U}{h^2 \kappa^2 N_b^3} . +\f] + +The superscript ref refers to reference values of the various parameters, as given by +observations from the Brazil basin. Therefore, the above can be rewritten as + +\f[ + z_p = \mu (N_b^\mbox{ref} )^2 + \frac{U}{h^2 \kappa^2 N_b^3} . +\f] + +where \f$\mu\f$ is a nondimensional constant \f$(\mu = 0.06970)\f$ and \f$N_b^\mbox{ref} = 9.6 \times +10^{-4} s^{-1}\f$. Finally, a minimum decay scale of \f$z_p = 100 m\f$ is imposed in our +implementation. + +\subsubsection subsection_reformulation_WKB Reformulation of the WKB scaling + +Since the dissipation is expressed as a function of the ratio \f$z^\ast / z_p\f$, a different WKB +scaling can be used so long as we modify \f$z_p\f$ accordingly. In the implemented parameterization, +we define the scaled height coordinate \f$z^\ast\f$ by + +\f[ + z^\ast (z) = \frac{1}{\overline{N^2 (z)}^z} \int_{0}^{z} N^2(z^\prime ) dz ^\prime , +\f] + +with \f$z^\prime\f$ defined to be the height above the ocean bottom. By normalizing \f$N^2\f$ by its +vertical mean \f$\overline{N^2}^z\f$, \f$z^\ast\f$ ranges from \f$0\f$ to \f$H\f$, the depth of the +ocean. + +The WKB-scaled vertical decay scale for the Polzin formulation becomes + +\f[ + z^\ast_p = \mu(N_b^\mbox{ref})^2 \frac{U}{h^2 \kappa^2 N_b \overline{N^2}^z} . +\f] + +Unlike the \cite st_laurent2002 parameterization, the vertical decay scale now depends on physical +variables and can evolve with a changing climate. + +Finally, the Polzin vertical profile of dissipation implemented in the model is given by + +\f[ + \epsilon = \frac{qE(x,y)}{\rho [1 + (z^\ast/z_p^\ast)]^2} \frac{N^2(z)}{\overline{N^2}^z} + \left( \frac{1}{H} + \frac{1}{z_p^\ast} \right) . +\f] + +In both parameterizations, turbulent diapycnal diffusivities are inferred from the dissipation +\f$\epsilon\f$ by: + +\f[ + K_d = \frac{\Gamma \epsilon}{N^2} +\f] + +and using this form of \f$\Gamma\f$: + +\f[ + \Gamma = 0.2 \frac{N^2}{N^2 + \Omega^2} +\f] + +instead of \f$\Gamma = 0.2\f$, where \f$\Omega\f$ is the angular velocity +of the Earth. This allows the buoyancy fluxes to tend to zero in regions +of very weak stratification, allowing a no-flux bottom boundary condition +to be satisfied. + +\subsection subsection_Lee_waves Nikurashin Lee Wave Mixing + +If one has the INT_TIDE_DISSIPATION flag on, there is an option to also turn on +LEE_WAVE_DISSIPATION. The theory is presented in \cite nikurashin2010a +while the application of it is presented in \cite nikurashin2010b. For +the implementation in MOM6, it is required that you provide an estimate +of the TKE loss due to the Lee waves which is then applied with either +the St. Laurent or the Polzin vertical profile. + +\todo Is there a script to produce this somewhere or what??? + +*/ diff --git a/src/parameterizations/vertical/_V_viscosity.dox b/src/parameterizations/vertical/_V_viscosity.dox new file mode 100644 index 0000000000..cc59e83457 --- /dev/null +++ b/src/parameterizations/vertical/_V_viscosity.dox @@ -0,0 +1,64 @@ +/*! \page Vertical_Viscosity Viscous Bottom Boundary Layer + +A drag law is used, either linearized about an assumed bottom velocity or using the +actual near-bottom velocities combined with an assumed unresolved velocity. The bottom +boundary layer thickness is limited by a combination of stratification and rotation, as +in the paper of \cite killworth1999. It is not necessary to calculate the +thickness and viscosity every time step; instead previous values may be used. + +\section set_viscous_BBL Viscous Bottom Boundary Layer + +If set_visc_CS\%bottomdraglaw is True then a bottom boundary layer viscosity and thickness +are calculated so that the bottom stress is +\f[ +\mathbf{\tau}_b = C_d | U_{bbl} | \mathbf{u}_{bbl} +\f] +If set_visc_CS\%bottomdraglaw is True then the term \f$|U_{bbl}|\f$ is set equal to the +value in set_visc_CS.drag_bg_vel so that \f$C_d |U_{bbl}|\f$ becomes a Rayleigh bottom drag. +Otherwise \f$|U_{bbl}|\f$ is found by averaging the flow over the bottom set_visc_CS\%hbbl +of the model, adding the amplitude of tides set_visc_CS\%tideamp and a constant +set_visc_CS\%drag_bg_vel. For these calculations the vertical grid at the velocity +component locations is found by +\f[ +\begin{array}{ll} +\frac{2 h^- h^+}{h^- + h^+} & u \left( h^+ - h^-\right) >= 0 +\\ +\frac{1}{2} \left( h^- + h^+ \right) & u \left( h^+ - h^-\right) < 0 +\end{array} +\f] +which biases towards the thin cell if the thin cell is upwind. Biasing the grid toward +thin upwind cells helps increase the effect of viscosity and inhibits flow out of these +thin cells. + +After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer +thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). +KW99 solve the equation +\f[ +\left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 +\f] +for the boundary layer depth \f$h_{bbl}\f$. Here +\f[ +h_f = \frac{C_n u_*}{f} +\f] +is the rotation controlled boundary layer depth in the absence of stratification. +\f$u_*\f$ is the surface friction speed given by +\f[ +u_*^2 = C_d |U_{bbl}|^2 +\f] +and is a function of near bottom model flow. +\f[ +h_N = \frac{C_i u_*}{N} = \frac{ (C_i u_* )^2 }{g^\prime} +\f] +is the stratification controlled boundary layer depth. The non-dimensional parameters +\f$C_n=0.5\f$ and \f$C_i=20\f$ are suggested by \cite zilitinkevich1996. + +If a Richardson number dependent mixing scheme is being used, as indicated by +set_visc_CS\%rino_mix, then the boundary layer thickness is bounded to be no larger +than a half of set_visc_CS\%hbbl . + +\todo Channel drag needs to be explained + +A BBL viscosity is calculated so that the no-slip boundary condition in the vertical +viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. + +*/ diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index c20eda7745..62181fe9ea 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -75,7 +75,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. character(len=200) :: inputdir - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to the tracer field logical :: register_DOME_tracer integer :: isd, ied, jsd, jed, nz, m isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -105,7 +105,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr_D",I1.1)') m @@ -166,13 +166,15 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & character(len=48) :: units ! The dimensions of the variable. character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to the tracer field real :: PI ! 3.1415926... calculated as 4*atan(1) real :: tr_y ! Initial zonally uniform tracer concentrations. 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 :: e(SZK_(GV)+1), e_top, e_bot ! Heights [Z ~> m]. - real :: d_tr ! A change in tracer concentraions, in tracer units. + real :: e(SZK_(GV)+1) ! Interface heights relative to the sea surface (negative down) [Z ~> m] + real :: e_top ! Height of the top of the tracer band relative to the sea surface [Z ~> m] + real :: e_bot ! Height of the bottom of the tracer band relative to the sea surface [Z ~> m] + real :: d_tr ! A change in tracer concentrations, in tracer units. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -215,9 +217,9 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & if (NTR > 7) then do j=js,je ; do i=is,ie - e(nz+1) = -G%bathyT(i,j) - do k=nz,1,-1 - e(K) = e(K+1) + h(i,j,k)*GV%H_to_Z + e(1) = 0.0 + do k=1,nz + e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z do m=7,NTR e_top = (-600.0*real(m-1) + 3000.0) * US%m_to_Z e_bot = (-600.0*real(m-1) + 2700.0) * US%m_to_Z diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 0e31282e9c..144b21e29a 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -110,7 +110,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr_D",I1.1)') m diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index e1770b0d52..187ce13b60 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -151,8 +151,8 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%CFC11_desc = var_desc(CS%CFC11_name,"mol kg-1","Moles Per Unit Mass of CFC-11 in sea water", caller=mdl) CS%CFC12_desc = var_desc(CS%CFC12_name,"mol kg-1","Moles Per Unit Mass of CFC-12 in sea water", caller=mdl) - allocate(CS%CFC11(isd:ied,jsd:jed,nz)) ; CS%CFC11(:,:,:) = 0.0 - allocate(CS%CFC12(isd:ied,jsd:jed,nz)) ; CS%CFC12(:,:,:) = 0.0 + allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0) ! This pointer assignment is needed to force the compiler not to do a copy in ! the registration calls. Curses on the designers and implementers of F90. diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index a1039fd1b7..43a1d7d174 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -163,8 +163,8 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) if (GV%Boussinesq) then ; flux_units = "mol s-1" else ; flux_units = "mol m-3 kg s-1" ; endif - allocate(CS%CFC11(isd:ied,jsd:jed,nz)) ; CS%CFC11(:,:,:) = 0.0 - allocate(CS%CFC12(isd:ied,jsd:jed,nz)) ; CS%CFC12(:,:,:) = 0.0 + allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0) ! This pointer assignment is needed to force the compiler not to do a copy in ! the registration calls. Curses on the designers and implementers of F90. diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 8f022821ea..dc6a121df1 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -626,9 +626,9 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ nk = SIZE(dz_top) ! allocate arrays - allocate(phi_L_z(nk)); phi_L_z(:) = 0.0 - allocate(phi_R_z(nk)); phi_R_z(:) = 0.0 - allocate(F_layer_z(nk)); F_layer_z(:) = 0.0 + allocate(phi_L_z(nk), source=0.0) + allocate(phi_R_z(nk), source=0.0) + allocate(F_layer_z(nk), source=0.0) ! remap tracer to dz_top call remapping_core_h(CS%remap_cs, ke, h_L(:), phi_L(:), nk, dz_top(:), phi_L_z(:)) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 03b89be1a4..4851bec9c1 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -250,24 +250,24 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, ! call closeParameterBlock(param_file) if (CS%continuous_reconstruction) then CS%nsurf = 2*GV%ke+2 ! Continuous reconstruction means that every interface has two connections - allocate(CS%dRdT(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%dRdT(:,:,:) = 0. - allocate(CS%dRdS(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%dRdS(:,:,:) = 0. + allocate(CS%dRdT(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%dRdS(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) else CS%nsurf = 4*GV%ke ! Discontinuous means that every interface has four connections - allocate(CS%T_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%T_i(:,:,:,:) = 0. - allocate(CS%S_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%S_i(:,:,:,:) = 0. - allocate(CS%P_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%P_i(:,:,:,:) = 0. - allocate(CS%dRdT_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%dRdT_i(:,:,:,:) = 0. - allocate(CS%dRdS_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%dRdS_i(:,:,:,:) = 0. - allocate(CS%ppoly_coeffs_T(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1)) ; CS%ppoly_coeffs_T(:,:,:,:) = 0. - allocate(CS%ppoly_coeffs_S(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1)) ; CS%ppoly_coeffs_S(:,:,:,:) = 0. - allocate(CS%ns(SZI_(G),SZJ_(G))) ; CS%ns(:,:) = 0. + allocate(CS%T_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%S_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%P_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%dRdT_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%dRdS_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%ppoly_coeffs_T(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1), source=0.) + allocate(CS%ppoly_coeffs_S(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1), source=0.) + allocate(CS%ns(SZI_(G),SZJ_(G)), source=0) endif ! T-points - allocate(CS%Tint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Tint(:,:,:) = 0. - allocate(CS%Sint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Sint(:,:,:) = 0. - allocate(CS%Pint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Pint(:,:,:) = 0. - allocate(CS%stable_cell(SZI_(G),SZJ_(G),SZK_(GV))) ; CS%stable_cell(:,:,:) = .true. + allocate(CS%Tint(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%Sint(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%Pint(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%stable_cell(SZI_(G),SZJ_(G),SZK_(GV)), source=.true.) ! U-points allocate(CS%uPoL(G%isd:G%ied,G%jsd:G%jed, CS%nsurf)); CS%uPoL(G%isc-1:G%iec,G%jsc:G%jec,:) = 0. allocate(CS%uPoR(G%isd:G%ied,G%jsd:G%jed, CS%nsurf)); CS%uPoR(G%isc-1:G%iec,G%jsc:G%jec,:) = 0. diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 59e63a5ddd..9486e87369 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -696,14 +696,10 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine if (do_ale) then - if (.not. associated(fluxes%netMassOut)) then - allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) - fluxes%netMassOut(:,:) = 0.0 - endif - if (.not. associated(fluxes%netMassIn)) then - allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed)) - fluxes%netMassIn(:,:) = 0.0 - endif + if (.not. associated(fluxes%netMassOut)) & + allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed), source=0.0) + if (.not. associated(fluxes%netMassIn)) & + allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed), source=0.0) fluxes%netMassOut(:,:) = 0.0 fluxes%netMassIn(:,:) = 0.0 diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 408120b4e5..0a61ee1ba2 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -895,6 +895,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB dt_iter = CS%US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) + x_before_y = CS%x_before_y do iter=1,CS%num_off_iter @@ -1434,17 +1435,15 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) CS%GV => GV ! Allocate arrays - allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz)) ; CS%uhtr(:,:,:) = 0.0 - allocate(CS%vhtr(isd:ied,JsdB:JedB,nz)) ; CS%vhtr(:,:,:) = 0.0 - allocate(CS%eatr(isd:ied,jsd:jed,nz)) ; CS%eatr(:,:,:) = 0.0 - allocate(CS%ebtr(isd:ied,jsd:jed,nz)) ; CS%ebtr(:,:,:) = 0.0 - allocate(CS%h_end(isd:ied,jsd:jed,nz)) ; CS%h_end(:,:,:) = 0.0 - allocate(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassOut(:,:) = 0.0 - allocate(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassIn(:,:) = 0.0 - allocate(CS%Kd(isd:ied,jsd:jed,nz+1)) ; CS%Kd = 0. - if (CS%read_mld) then - allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed)) ; CS%mld(:,:) = 0.0 - endif + allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(CS%vhtr(isd:ied,JsdB:JedB,nz), source=0.0) + allocate(CS%eatr(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%ebtr(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%h_end(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%Kd(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%read_mld) allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed), source=0.0) if (CS%read_all_ts_uvh) then call read_all_input(CS) @@ -1480,11 +1479,11 @@ subroutine read_all_input(CS) if (allocated(CS%temp_all)) call MOM_error(FATAL, "temp_all is already allocated") if (allocated(CS%salt_all)) call MOM_error(FATAL, "salt_all is already allocated") - allocate(CS%uhtr_all(IsdB:IedB,jsd:jed,nz,ntime)) ; CS%uhtr_all(:,:,:,:) = 0.0 - allocate(CS%vhtr_all(isd:ied,JsdB:JedB,nz,ntime)) ; CS%vhtr_all(:,:,:,:) = 0.0 - allocate(CS%hend_all(isd:ied,jsd:jed,nz,ntime)) ; CS%hend_all(:,:,:,:) = 0.0 - allocate(CS%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%temp_all(:,:,:,:) = 0.0 - allocate(CS%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%salt_all(:,:,:,:) = 0.0 + allocate(CS%uhtr_all(IsdB:IedB,jsd:jed,nz,ntime), source=0.0) + allocate(CS%vhtr_all(isd:ied,JsdB:JedB,nz,ntime), source=0.0) + allocate(CS%hend_all(isd:ied,jsd:jed,nz,ntime), source=0.0) + allocate(CS%temp_all(isd:ied,jsd:jed,nz,1:ntime), source=0.0) + allocate(CS%salt_all(isd:ied,jsd:jed,nz,1:ntime), source=0.0) call MOM_mesg("Reading in uhtr, vhtr, h_start, h_end, temp, salt") do t = 1,ntime diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index ad0a997cc4..cd6572cc9c 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -96,8 +96,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va return endif - allocate(tr_in(G%isd:G%ied,G%jsd:G%jed,nz_in)) ; tr_in(:,:,:) = 0.0 - allocate(tr_1d(nz_in)) ; tr_1d(:) = 0.0 + allocate(tr_in(G%isd:G%ied,G%jsd:G%jed,nz_in), source=0.0) + allocate(tr_1d(nz_in), source=0.0) call MOM_read_data(filename, tr_name, tr_in(:,:,:), G%Domain) ! Fill missing values from above? Use a "close" test to avoid problems @@ -137,8 +137,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%bathyT(i,j) + G%Z_ref) / htot(i) + e(nz+1) = -G%bathyT(i,j) - G%Z_ref do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. Efficiency is not an issue here. @@ -212,8 +212,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va do i=is,ie ; if (G%mask2dT(i,j)*htot(i) > 0.0) then ! Determine the z* heights of the model interfaces. - dilate = (G%bathyT(i,j) - 0.0) / htot(i) - e(nz+1) = -G%bathyT(i,j) + dilate = (G%bathyT(i,j) + G%Z_ref) / htot(i) + e(nz+1) = -G%bathyT(i,j) - G%Z_ref do k=nz,1,-1 ; e(K) = e(K+1) + dilate * h(i,j,k) ; enddo ! Create a single-column copy of tr_in. Efficiency is not an issue here. @@ -426,7 +426,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & call read_attribute(filename, "edges", edge_name, varname=dim_names(3), found=has_edges, ncid_in=ncid) nz_edge = sizes(3) ; if (has_edges) nz_edge = sizes(3)+1 - allocate(z_edges(nz_edge)) ; z_edges(:) = 0.0 + allocate(z_edges(nz_edge), source=0.0) if (nz_out < 1) return diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 439e9b5396..9426ced9ca 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -65,6 +65,8 @@ module MOM_tracer_flow_control use boundary_impulse_tracer, only : boundary_impulse_tracer_column_physics, boundary_impulse_tracer_surface_state use boundary_impulse_tracer, only : boundary_impulse_stock, boundary_impulse_tracer_end use boundary_impulse_tracer, only : boundary_impulse_tracer_CS +use nw2_tracers, only : nw2_tracers_CS, register_nw2_tracers, nw2_tracer_column_physics +use nw2_tracers, only : initialize_nw2_tracers, nw2_tracers_end implicit none ; private @@ -88,6 +90,7 @@ module MOM_tracer_flow_control logical :: use_pseudo_salt_tracer = .false. !< If true, use the psuedo_salt tracer package logical :: use_boundary_impulse_tracer = .false. !< If true, use the boundary impulse tracer package logical :: use_dyed_obc_tracer = .false. !< If true, use the dyed OBC tracer package + logical :: use_nw2_tracers = .false. !< If true, use the NW2 tracer package !>@{ Pointers to the control strucures for the tracer packages type(USER_tracer_example_CS), pointer :: USER_tracer_example_CSp => NULL() type(DOME_tracer_CS), pointer :: DOME_tracer_CSp => NULL() @@ -103,6 +106,7 @@ module MOM_tracer_flow_control type(pseudo_salt_tracer_CS), pointer :: pseudo_salt_tracer_CSp => NULL() type(boundary_impulse_tracer_CS), pointer :: boundary_impulse_tracer_CSp => NULL() type(dyed_obc_tracer_CS), pointer :: dyed_obc_tracer_CSp => NULL() + type(nw2_tracers_CS), pointer :: nw2_tracers_CSp => NULL() !>@} end type tracer_flow_control_CS @@ -214,6 +218,9 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "USE_DYED_OBC_TRACER", CS%use_dyed_obc_tracer, & "If true, use the dyed_obc_tracer tracer package.", & default=.false.) + call get_param(param_file, mdl, "USE_NW2_TRACERS", CS%use_nw2_tracers, & + "If true, use the NeverWorld2 tracers.", & + default=.false.) ! Add other user-provided calls to register tracers for restarting here. Each ! tracer package registration call returns a logical false if it cannot be run @@ -260,7 +267,8 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = & register_dyed_obc_tracer(HI, GV, param_file, CS%dyed_obc_tracer_CSp, & tr_Reg, restart_CS) - + if (CS%use_nw2_tracers) CS%use_nw2_tracers = & + register_nw2_tracers(HI, GV, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register @@ -342,6 +350,8 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag sponge_CSp, tv) if (CS%use_dyed_obc_tracer) & call initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS%dyed_obc_tracer_CSp) + if (CS%use_nw2_tracers) & + call initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS%nw2_tracers_CSp) end subroutine tracer_flow_control_init @@ -505,8 +515,11 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, US, CS%dyed_obc_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) - - + if (CS%use_nw2_tracers) & + call nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & + G, GV, US, tv, CS%nw2_tracers_CSp, & + evap_CFL_limit=evap_CFL_limit, & + minimum_forcing_depth=minimum_forcing_depth) else ! Apply tracer surface fluxes using ea on the first layer if (CS%use_USER_tracer_example) & call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & @@ -554,10 +567,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_dyed_obc_tracer) & call dyed_obc_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%dyed_obc_tracer_CSp) - + if (CS%use_nw2_tracers) call nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & + G, GV, US, tv, CS%nw2_tracers_CSp) endif - end subroutine call_tracer_column_fns !> This subroutine calls all registered tracer packages to enable them to @@ -807,6 +820,7 @@ subroutine tracer_flow_control_end(CS) if (CS%use_pseudo_salt_tracer) call pseudo_salt_tracer_end(CS%pseudo_salt_tracer_CSp) if (CS%use_boundary_impulse_tracer) call boundary_impulse_tracer_end(CS%boundary_impulse_tracer_CSp) if (CS%use_dyed_obc_tracer) call dyed_obc_tracer_end(CS%dyed_obc_tracer_CSp) + if (CS%use_nw2_tracers) call nw2_tracers_end(CS%nw2_tracers_CSp) if (associated(CS)) deallocate(CS) end subroutine tracer_flow_control_end diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 766d6ae7c8..bb12d316cb 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -428,7 +428,7 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) trim(flux_units), v_extensive=.true., y_cell_method='sum', & conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T) Tr%id_dfy = register_diag_field("ocean_model", trim(shortnm)//"_dfy", & - diag%axesCvL, Time, trim(flux_longname)//" diffusive zonal flux" , & + diag%axesCvL, Time, trim(flux_longname)//" diffusive meridional flux" , & trim(flux_units), v_extensive=.true., x_cell_method='sum', & conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T) Tr%id_lbd_dfx = register_diag_field("ocean_model", trim(shortnm)//"_lbd_diffx", & diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 59058abeda..6d355db36f 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -125,9 +125,9 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The length of the sponge layer (km).", & default=10.0) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) if (CS%mask_tracers) then - allocate(CS%tr_aux(isd:ied,jsd:jed,nz,NTR)) ; CS%tr_aux(:,:,:,:) = 0.0 + allocate(CS%tr_aux(isd:ied,jsd:jed,nz,NTR), source=0.0) endif do m=1,NTR diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 9d328e7a8f..4d05d43fd9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -127,7 +127,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ "restart files of a restarted run.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr",I1.1)') m diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 4856abaefd..3aaa51b301 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -106,7 +106,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar "it is a fatal error if the tracers are not found in the "//& "restart files of a restarted run.", default=.false.) CS%ntr = NTR_MAX - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) CS%nkml = max(GV%nkml,1) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 2919f2d95f..a26c967eae 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -149,7 +149,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (minval(CS%dye_source_maxdepth(:)) < -1.e29*US%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ") - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m = 1, CS%ntr write(var_name(:),'(A,I3.3)') "dye",m @@ -203,9 +203,10 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C character(len=48) :: units ! The dimensions of the variable. character(len=48) :: flux_units ! The units for age tracer fluxes, either ! years m3 s-1 or years kg s-1. + real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] + real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] logical :: OK integer :: i, j, k, m - real :: z_bot, z_center if (.not.associated(CS)) return if (CS%ntr < 1) return @@ -221,14 +222,14 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%bathyT(i,j) - do k = GV%ke, 1, -1 + z_bot = 0.0 + do k = 1, GV%ke + z_bot = z_bot - h(i,j,k)*GV%H_to_Z z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo @@ -273,9 +274,10 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US real :: sfc_val ! The surface value for the tracers. real :: Isecs_per_year ! The number of seconds in a year. real :: year ! The time in years. + real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] + real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] integer :: secs, days ! Integer components of the time type. integer :: i, j, k, is, ie, js, je, nz, m - real :: z_bot, z_center is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -305,14 +307,14 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then - z_bot = -G%bathyT(i,j) - do k=nz,1,-1 + z_bot = 0.0 + do k=1,nz + z_bot = z_bot - h_new(i,j,k)*GV%H_to_Z z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 endif - z_bot = z_bot + h_new(i,j,k)*GV%H_to_Z enddo endif enddo ; enddo diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index eb49d0beef..f299febfa8 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -98,7 +98,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%tracer_IC_file) endif - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m=1,CS%ntr write(name,'("dye_",I2.2)') m diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 19e1df59dc..ffe4f9df72 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -163,7 +163,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) units="years", default=0.0) endif - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m=1,CS%ntr ! This is needed to force the compiler not to do a copy in the registration diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 new file mode 100644 index 0000000000..4578a422dc --- /dev/null +++ b/src/tracer/nw2_tracers.F90 @@ -0,0 +1,314 @@ +!> Ideal tracers designed to help diagnose a tracer diffusivity tensor in NeverWorld2 +module nw2_tracers + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc +use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_time_manager, only : time_type, time_type_to_real +use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type + +implicit none ; private + +#include + +public register_nw2_tracers +public initialize_nw2_tracers +public nw2_tracer_column_physics +public nw2_tracers_end + +!> The control structure for the nw2_tracers package +type, public :: nw2_tracers_CS ; private + integer :: ntr = 0 !< The number of tracers that are actually used. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? + real, allocatable , dimension(:) :: restore_rate !< The exponential growth rate for restoration value [year-1]. + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure +end type nw2_tracers_CS + +contains + +!> Register the NW2 tracer fields to be used with MOM. +logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS) + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure + 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(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracer. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the control + !! structure for the tracer advection and + !! diffusion module + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "nw2_tracers" ! This module's name. + character(len=200) :: inputdir ! The directory where the input files are. + character(len=8) :: var_name ! The variable's name. + real, pointer :: tr_ptr(:,:,:) => NULL() + logical :: do_nw2 + integer :: isd, ied, jsd, jed, nz, m, ig + integer :: n_groups ! Number of groups of three tracers (i.e. # tracers/3) + real, allocatable, dimension(:) :: timescale_in_days + type(vardesc) :: tr_desc ! Descriptions and metadata for the tracers + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + + if (associated(CS)) then + call MOM_error(FATAL, "register_nw2_tracer called with an "// & + "associated control structure.") + return + endif + allocate(CS) + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NW2_TRACER_GROUPS", n_groups, & + "The number of tracer groups where a group is of three tracers "//& + "initialized and restored to sin(x), y and z, respectively. Each "//& + "group is restored with an independent restoration rate.", & + default=3) + allocate(timescale_in_days(n_groups)) + timescale_in_days = (/365., 730., 1460./) + call get_param(param_file, mdl, "NW2_TRACER_RESTORE_TIMESCALE", timescale_in_days, & + "A list of timescales, one for each tracer group.", & + units="days") + + CS%ntr = 3 * n_groups + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) + allocate(CS%restore_rate(CS%ntr)) + + do m=1,CS%ntr + write(var_name(1:8),'(a6,i2.2)') 'tracer',m + tr_desc = var_desc(var_name, "1", "Ideal Tracer", caller=mdl) + ! This is needed to force the compiler not to do a copy in the registration + ! calls. Curses on the designers and implementers of Fortran90. + tr_ptr => CS%tr(:,:,:,m) + ! Register the tracer for horizontal advection, diffusion, and restarts. + call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, tr_desc=tr_desc, & + registry_diags=.true., restart_CS=restart_CS, mandatory=.false.) + ig = int( (m+2)/3 ) ! maps (1,2,3)->1, (4,5,6)->2, ... + CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0 ) + enddo + + CS%tr_Reg => tr_Reg + CS%restart_CSp => restart_CS + register_nw2_tracers = .true. +end function register_nw2_tracers + +!> Sets the NW2 traces to their initial values and sets up the tracer output +subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) + logical, intent(in) :: restart !< .true. if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + 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 + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracer. + ! Local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights + real :: rscl ! z* scaling factor + character(len=8) :: var_name ! The variable's name. + integer :: i, j, k, m + + if (.not.associated(CS)) return + + CS%Time => day + CS%diag => diag + + ! Calculate z* interface positions + if (GV%Boussinesq) then + ! First calculate interface positions in z-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j) + enddo ; enddo + do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z + enddo ; enddo ; enddo + ! Re-calculate for interface positions in z*-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (G%bathyT(i,j)>0.) then + rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) ) + do K=GV%ke, 1, -1 + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z * rscl + enddo + endif + enddo ; enddo + else + call MOM_error(FATAL, "NW2 tracers assume Boussinesq mode") + endif + + do m=1,CS%ntr + ! Initialize only if this is not a restart or we are using a restart + ! in which the tracers were not present + write(var_name(1:8),'(a6,i2.2)') 'tracer',m + if ((.not.restart) .or. & + (.not. query_initialized(CS%tr(:,:,:,m),var_name,CS%restart_CSp))) then + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%tr(i,j,k,m) = nw2_tracer_dist(m, G, GV, eta, i, j, k) + enddo ; enddo ; enddo + endif ! restart + enddo ! Tracer loop + +end subroutine initialize_nw2_tracers + +!> Applies diapycnal diffusion, aging and regeneration at the surface to the NW2 tracers +subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, & + evap_CFL_limit, minimum_forcing_depth) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid entrained + !! from the layer above during this call will be + !! added [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid entrained + !! from the layer below during this call will be + !! added [H ~> m or kg m-2]. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic + !! and tracer forcing fields. Unused fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracer. + real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can + !! be fluxed out of the top layer in a timestep [nondim] + real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which + !! fluxes can be applied [H ~> m or kg m-2] +! This subroutine applies diapycnal diffusion and any other column +! tracer physics or chemistry to the tracers from this file. +! This is a simple example of a set of advected passive tracers. + +! The arguments to this subroutine are redundant in that +! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) + ! Local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights + integer :: i, j, k, m + real :: dt_x_rate ! dt * restoring rate + real :: rscl ! z* scaling factor + real :: target_value ! tracer value + +! if (.not.associated(CS)) return + + if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + do m=1,CS%ntr + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + h_work(i,j,k) = h_old(i,j,k) + enddo ; enddo ; enddo + call applyTracerBoundaryFluxesInOut(G, GV, CS%tr(:,:,:,m), dt, fluxes, h_work, & + evap_CFL_limit, minimum_forcing_depth) + call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + else + do m=1,CS%ntr + call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + endif + + ! Calculate z* interface positions + if (GV%Boussinesq) then + ! First calculate interface positions in z-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j) + enddo ; enddo + do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z + enddo ; enddo ; enddo + ! Re-calculate for interface positions in z*-space (m) + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (G%bathyT(i,j)>0.) then + rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) ) + do K=GV%ke, 1, -1 + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z * rscl + enddo + endif + enddo ; enddo + else + call MOM_error(FATAL, "NW2 tracers assume Boussinesq mode") + endif + + do m=1,CS%ntr + dt_x_rate = ( dt * CS%restore_rate(m) ) * US%T_to_s +!$OMP parallel do default(private) shared(CS,G,dt,dt_x_rate) + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + target_value = nw2_tracer_dist(m, G, GV, eta, i, j, k) + CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j) * dt_x_rate * ( target_value - CS%tr(i,j,k,m) ) + enddo ; enddo ; enddo + enddo + +end subroutine nw2_tracer_column_physics + +!> The target value of a NeverWorld2 tracer label m at non-dimensional +!! position x=lon/Lx, y=lat/Ly, z=eta/H +real function nw2_tracer_dist(m, G, GV, eta, i, j, k) + integer, intent(in) :: m !< Indicates the NW2 tracer + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),0:SZK_(G)), & + intent(in) :: eta !< Interface position [m] + integer, intent(in) :: i !< Cell index i + integer, intent(in) :: j !< Cell index j + integer, intent(in) :: k !< Layer index k + ! Local variables + real :: pi ! 3.1415... + real :: x, y, z ! non-dimensional positions + pi = 2.*acos(0.) + x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1 + y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1 + z = - 0.5 * ( eta(i,j,K-1) + eta(i,j,K) ) / GV%max_depth ! 0 ... 1 + select case ( mod(m-1,3) ) + case (0) ! sin(2 pi x/L) + nw2_tracer_dist = sin( 2.0 * pi * x ) + case (1) ! y/L + nw2_tracer_dist = y + case (2) ! -z/L + nw2_tracer_dist = -z + case default + stop 'This should not happen. Died in nw2_tracer_dist()!' + end select + nw2_tracer_dist = nw2_tracer_dist * G%mask2dT(i,j) +end function nw2_tracer_dist + +!> Deallocate any memory associated with this tracer package +subroutine nw2_tracers_end(CS) + type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous + !! call to register_nw2_tracers. + + integer :: m + + if (associated(CS)) then + if (associated(CS%tr)) deallocate(CS%tr) + deallocate(CS) + endif +end subroutine nw2_tracers_end + +!> \namespace nw2_tracers +!! +!! TBD + +end module nw2_tracers diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index df96193181..fcc0de23d8 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -169,7 +169,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (GV%Boussinesq) then ; flux_units = "kg s-1" else ; flux_units = "kg m-3 kg s-1" ; endif - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m=1,CS%ntr ! This is needed to force the compiler not to do a copy in the registration diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index eb15c05580..cd1ee41ebd 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -88,8 +88,8 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") - allocate(CS%ps(isd:ied,jsd:jed,nz)) ; CS%ps(:,:,:) = 0.0 - allocate(CS%diff(isd:ied,jsd:jed,nz)) ; CS%diff(:,:,:) = 0.0 + allocate(CS%ps(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%diff(isd:ied,jsd:jed,nz), source=0.0) CS%tr_desc = var_desc(trim("pseudo_salt"), "psu", & "Pseudo salt passive tracer", caller=mdl) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 349720304b..3eb83a79c5 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -99,7 +99,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr",I1.1)') m diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index f632b95086..49c0a03235 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -76,13 +76,15 @@ end subroutine BFB_set_coord !> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs !! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. -subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, param_file, CSp, h) +subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, depth_tot, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, intent(in) :: use_temperature !< If true, temperature and salinity are used as !! state variables. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(sponge_CS), pointer :: CSp !< A pointer to the sponge control structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -129,7 +131,7 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, para max_damping = 1.0 / (86400.0*US%s_to_T) do j=js,je ; do i=is,ie - if (G%bathyT(i,j) <= min_depth) then ; Idamp(i,j) = 0.0 + if (depth_tot(i,j) <= min_depth) then ; Idamp(i,j) = 0.0 elseif (G%geoLatT(i,j) < slat+2.0) then ; Idamp(i,j) = max_damping elseif (G%geoLatT(i,j) < slat+4.0) then Idamp(i,j) = max_damping * (slat+4.0-G%geoLatT(i,j))/2.0 diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 293d601757..f99f0b8d5c 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -90,12 +90,14 @@ subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) end subroutine DOME2d_initialize_topography !> Initialize thicknesses according to coordinate mode -subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_params ) +subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params ) 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 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -150,7 +152,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par case ( REGRIDDING_LAYER, REGRIDDING_RHO ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then @@ -172,7 +174,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par ! case ( IC_RHO_C ) ! ! do j=js,je ; do i=is,ie - ! eta1D(nz+1) = -G%bathyT(i,j) + ! eta1D(nz+1) = -depth_tot(i,j) ! do k=nz,1,-1 ! eta1D(k) = e0(k) ! if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -194,7 +196,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par case ( REGRIDDING_ZSTAR ) do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -208,7 +210,7 @@ subroutine DOME2d_initialize_thickness ( h, G, GV, US, param_file, just_read_par case ( REGRIDDING_SIGMA ) do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H*G%bathyT(i,j) / nz + h(i,j,:) = GV%Z_to_H*depth_tot(i,j) / nz enddo ; enddo case default @@ -353,11 +355,13 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, param_file, end subroutine DOME2d_initialize_temperature_salinity !> Set up sponges in 2d DOME configuration -subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, ACSp) +subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_ALE, CSp, ACSp) 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(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: use_ALE !< If true, indicates model is in ALE mode type(sponge_CS), pointer :: CSp !< Layer-mode sponge structure @@ -453,7 +457,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then @@ -470,7 +474,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC ! Construct temperature and salinity on the arbitrary grid T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 do j=js,je ; do i=is,ie - z = -G%bathyT(i,j) + z = -depth_tot(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)) @@ -491,7 +495,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC ! Construct interface heights to restore toward do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(K) = -G%max_depth * real(k-1) / real(nz) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then @@ -508,7 +512,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC d_eta(nz) = dome2d_depth_bay * G%max_depth - (nz-1) * GV%Angstrom_Z endif - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -depth_tot(i,j) do K=nz,1,-1 eta(i,j,K) = eta(i,j,K+1) + d_eta(k) enddo diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index c56e2ab63f..1f3d24e1c9 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -26,7 +26,7 @@ module DOME_initialization public DOME_initialize_topography public DOME_initialize_thickness public DOME_initialize_sponges -public DOME_set_OBC_data +public DOME_set_OBC_data, register_DOME_OBC ! 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 @@ -87,11 +87,13 @@ end subroutine DOME_initialize_topography ! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the DOME experiment -subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) +subroutine DOME_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -124,7 +126,7 @@ subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) ! Angstrom thick, and 2. the interfaces are where they should be ! ! based on the resting depths and interface height perturbations, ! ! as long at this doesn't interfere with 1. ! - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then @@ -145,17 +147,19 @@ end subroutine DOME_initialize_thickness !! number of tracers should be restored within each sponge. The ! !! interface height is always subject to damping, and must always be ! !! the first registered field. ! -subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. +subroutine DOME_initialize_sponges(G, GV, US, tv, depth_tot, PF, CSp) + 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(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available - !! thermodynamic fields, including potential temperature and - !! salinity or mixed layer density. Absent fields have NULL ptrs. - type(param_file_type), intent(in) :: PF !< A structure indicating the open file to - !! parse for model parameter values. - type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control - !! structure for this module. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available + !! thermodynamic fields, including potential temperature and + !! salinity or mixed layer density. Absent fields have NULL ptrs. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: PF !< A structure indicating the open file to + !! parse for model parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to the control + !! structure for this module. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables. ! @@ -204,16 +208,16 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) ! depth space for Boussinesq or non-Boussinesq models. eta(i,j,1) = 0.0 do k=2,nz -! eta(i,j,K)=max(H0(k), -G%bathyT(i,j), GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) - e_dense = -G%bathyT(i,j) +! eta(i,j,K) = max(H0(k), -depth_tot(i,j), GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j)) + e_dense = -depth_tot(i,j) if (e_dense >= H0(k)) then ; eta(i,j,K) = e_dense else ; eta(i,j,K) = H0(k) ; endif - if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j)) & - eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - G%bathyT(i,j) + if (eta(i,j,K) < GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j)) & + eta(i,j,K) = GV%Angstrom_Z*(nz-k+1) - depth_tot(i,j) enddo - eta(i,j,nz+1) = -G%bathyT(i,j) + eta(i,j,nz+1) = -depth_tot(i,j) - if (G%bathyT(i,j) > min_depth) then + if (depth_tot(i,j) > min_depth) then Idamp(i,j) = damp / 86400.0 else ; Idamp(i,j) = 0.0 ; endif enddo ; enddo @@ -241,6 +245,30 @@ subroutine DOME_initialize_sponges(G, GV, US, tv, PF, CSp) end subroutine DOME_initialize_sponges +!> Add DOME to the OBC registry and set up some variables that will be used to guide +!! code setting up the restart fieldss related to the OBCs. +subroutine register_DOME_OBC(param_file, US, OBC, tr_Reg) + type(param_file_type), intent(in) :: param_file !< parameter file. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(ocean_OBC_type), pointer :: OBC !< OBC registry. + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. + + if (OBC%number_of_segments /= 1) then + call MOM_error(FATAL, 'Error in register_DOME_OBC - DOME should have 1 OBC segment', .true.) + endif + + ! Store this information for use in setting up the OBC restarts for tracer reservoirs. + OBC%ntr = tr_Reg%ntr + if (.not. associated(OBC%tracer_x_reservoirs_used)) then + allocate(OBC%tracer_x_reservoirs_used(OBC%ntr)) + allocate(OBC%tracer_y_reservoirs_used(OBC%ntr)) + OBC%tracer_x_reservoirs_used(:) = .false. + OBC%tracer_y_reservoirs_used(:) = .false. + OBC%tracer_y_reservoirs_used(1) = .true. + endif + +end subroutine register_DOME_OBC + !> This subroutine sets the properties of flow at open boundary conditions. !! This particular example is for the DOME inflow describe in Legg et al. 2006. subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) @@ -276,8 +304,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) 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. - character(len=32) :: name - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz, NTR + character(len=32) :: name ! The name of a tracer field. + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, m, nz integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() type(tracer_type), pointer :: tr_ptr => NULL() @@ -302,22 +330,10 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) return !!! Need a better error message here endif - NTR = tr_Reg%NTR - - ! Stash this information away for the messy tracer restarts. - OBC%ntr = NTR - if (.not. associated(OBC%tracer_x_reservoirs_used)) then - allocate(OBC%tracer_x_reservoirs_used(NTR)) - allocate(OBC%tracer_y_reservoirs_used(NTR)) - OBC%tracer_x_reservoirs_used(:) = .false. - OBC%tracer_y_reservoirs_used(:) = .false. - OBC%tracer_y_reservoirs_used(1) = .true. - endif - segment => OBC%segment(1) if (.not. segment%on_pe) return - allocate(segment%field(NTR)) + allocate(segment%field(tr_Reg%ntr)) do k=1,nz rst = -1.0 @@ -393,9 +409,9 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, param_file, tr_Reg) call register_segment_tracer(tr_ptr, param_file, GV, & OBC%segment(1), OBC_array=.true.) - ! All tracers but the first have 0 concentration in their inflows. As this - ! is the default value, the following calls are unnecessary. - do m=2,NTR + ! All tracers but the first have 0 concentration in their inflows. As 0 is the + ! default value for the inflow concentrations, the following calls are unnecessary. + do m=2,tr_Reg%ntr if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif call tracer_name_lookup(tr_Reg, tr_ptr, name) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index aa1c6cdfe6..76f60d9b99 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -128,12 +128,14 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) end subroutine ISOMIP_initialize_topography !> Initialization of thicknesses -subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read_params) +subroutine ISOMIP_initialize_thickness ( h, depth_tot, G, GV, US, param_file, tv, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any @@ -206,7 +208,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then @@ -221,7 +223,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -236,7 +238,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * depth_tot(i,j) / dfloat(nz) enddo ; enddo case default @@ -248,7 +250,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read end subroutine ISOMIP_initialize_thickness !> Initial values for temperature and salinity -subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, & +subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, US, param_file, & eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -256,6 +258,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: depth_tot !< The nominal total bottom-to-top + !! depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -315,7 +319,7 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie - xi0 = -G%bathyT(i,j) + xi0 = -depth_tot(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 @@ -420,7 +424,7 @@ end subroutine ISOMIP_initialize_temperature_salinity !> 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. -subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) +subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, 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. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -429,6 +433,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) !! fields, potential temperature and !! salinity or mixed layer density. !! Absent fields have NULL ptrs. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -508,7 +514,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! and mask2dT is 1. do j=js,je ; do i=is,ie - if (G%bathyT(i,j) <= min_depth) then + if (depth_tot(i,j) <= min_depth) then Idamp(i,j) = 0.0 elseif (G%geoLonT(i,j) >= 790.0 .AND. G%geoLonT(i,j) <= 800.0) then dummy1 = (G%geoLonT(i,j)-790.0)/(800.0-790.0) @@ -549,7 +555,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) ! Calculate thicknesses do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then @@ -563,7 +569,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -577,7 +583,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * (G%bathyT(i,j) / dfloat(nz)) + h(i,j,:) = GV%Z_to_H * (depth_tot(i,j) / dfloat(nz)) enddo ; enddo case default @@ -593,7 +599,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) dS_dz = (s_sur - s_bot) / G%max_depth dT_dz = (t_sur - t_bot) / G%max_depth do j=js,je ; do i=is,ie - xi0 = -G%bathyT(i,j) + xi0 = -depth_tot(i,j) do k = nz,1,-1 xi0 = xi0 + 0.5 * h(i,j,k) * GV%H_to_Z ! Depth in middle of layer S(i,j,k) = S_sur + dS_dz * xi0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 4a136dd2db..fe5168ab7e 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -186,6 +186,7 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) real :: lambda ! Offshore decay scale [L-1 ~> m-1] real :: omega ! Wave frequency [T-1 ~> s-1] real :: PI + real :: depth_tot(SZI_(G),SZJ_(G)) ! The total depth of the ocean [Z ~> m] integer :: i, j, k, n, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB real :: mag_SSH ! An overall magnitude of the external wave sea surface height at the coastline [Z ~> m] @@ -209,6 +210,13 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) PI = 4.0*atan(1.0) km_to_L_scale = 1000.0*US%m_to_L + do j=jsd,jed ; do i=isd,ied + depth_tot(i,j) = 0.0 + enddo ; enddo + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + depth_tot(i,j) = depth_tot(i,j) + GV%H_to_Z * h(i,j,k) + enddo ; enddo ; enddo + if (CS%mode == 0) then mag_SSH = 1.0*US%m_to_Z omega = 2.0 * PI / (12.42 * 3600.0*US%s_to_T) ! M2 Tide period @@ -245,20 +253,17 @@ 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 ! Use inside bathymetry - cff = sqrt(GV%g_Earth * G%bathyT(i+1,j) ) + cff = sqrt(GV%g_Earth * depth_tot(i+1,j) ) val2 = mag_SSH * exp(- CS%F_0 * y / cff) segment%eta(I,j) = GV%Z_to_H*val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = (val2 * (val1 * cff * cosa / & - (G%bathyT(i+1,j) )) ) + segment%normal_vel_bt(I,j) = val2 * (val1 * cff * cosa / depth_tot(i+1,j) ) if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = (val2 * (val1 * cff * cosa / & - (G%bathyT(i+1,j))) ) + segment%nudged_normal_vel(I,j,k) = val2 * (val1 * cff * cosa / depth_tot(i+1,j) ) enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = (val2 * (val1 * cff * cosa / & - (G%bathyT(i+1,j) )) ) + segment%normal_vel(I,j,k) = val2 * (val1 * cff * cosa / depth_tot(i+1,j) ) segment%normal_trans(I,j,k) = segment%normal_vel(I,j,k) * h(i+1,j,k) * G%dyCu(I,j) enddo endif @@ -288,11 +293,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = km_to_L_scale * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - cff = sqrt(GV%g_Earth * G%bathyT(i+1,j) ) + cff = sqrt(GV%g_Earth * depth_tot(i+1,j) ) val2 = mag_SSH * exp(- CS%F_0 * y / cff) if (CS%mode == 0) then ; do k=1,nz segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & - ( 0.5*(G%bathyT(i+1,j+1) + G%bathyT(i+1,j) ) ) + ( 0.5*(depth_tot(i+1,j+1) + depth_tot(i+1,j) ) ) enddo ; endif enddo ; enddo @@ -306,20 +311,17 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa if (CS%mode == 0) then - cff = sqrt(GV%g_Earth * G%bathyT(i,j+1) ) + cff = sqrt(GV%g_Earth * depth_tot(i,j+1) ) val2 = mag_SSH * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) segment%eta(I,j) = GV%Z_to_H*val2 * cos(omega * time_sec) - segment%normal_vel_bt(I,j) = (val1 * cff * sina / & - (G%bathyT(i,j+1) )) * val2 + segment%normal_vel_bt(I,j) = (val1 * cff * sina / depth_tot(i,j+1) ) * val2 if (segment%nudged) then do k=1,nz - segment%nudged_normal_vel(I,j,k) = (val1 * cff * sina / & - (G%bathyT(i,j+1) )) * val2 + segment%nudged_normal_vel(I,j,k) = (val1 * cff * sina / depth_tot(i,j+1)) * val2 enddo elseif (segment%specified) then do k=1,nz - segment%normal_vel(I,j,k) = (val1 * cff * sina / & - (G%bathyT(i,j+1) )) * val2 + segment%normal_vel(I,j,k) = (val1 * cff * sina / depth_tot(i,j+1) ) * val2 segment%normal_trans(i,J,k) = segment%normal_vel(i,J,k) * h(i,j+1,k) * G%dxCv(i,J) enddo endif @@ -347,11 +349,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) y1 = km_to_L_scale * G%geoLatBu(I,J) x = (x1 - CS%coast_offset1) * cosa + y1 * sina y = - (x1 - CS%coast_offset1) * sina + y1 * cosa - cff = sqrt(GV%g_Earth * G%bathyT(i,j+1) ) + cff = sqrt(GV%g_Earth * depth_tot(i,j+1) ) val2 = mag_SSH * exp(- 0.5 * (G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J)) * y / cff) if (CS%mode == 0) then ; do k=1,nz - segment%tangential_vel(I,J,k) = ((val1 * val2 * cff * sina) / & - ( 0.5*((G%bathyT(i+1,j+1)) + G%bathyT(i,j+1))) ) + segment%tangential_vel(I,J,k) = (val1 * val2 * cff * sina) / & + ( 0.5*(depth_tot(i+1,j+1) + depth_tot(i,j+1)) ) enddo ; endif enddo ; enddo endif diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 2f0d95a62d..10c3af7385 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -332,12 +332,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) "STK_BAND_COUPLER is the number of Stokes drift bands in the coupler. "// & "This has to be consistent with the number of Stokes drift bands in WW3, "//& "or the model will fail.",units='', default=1) - allocate( CS%WaveNum_Cen(CS%NumBands) ) - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands)) - allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands)) - CS%WaveNum_Cen(:) = 0.0 - CS%STKx0(:,:,:) = 0.0 - CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(CS%NumBands), source=0.0 ) + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) + allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -349,16 +346,11 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) "Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and "// & "STOKES_Y, there are no safety checks in the code.", & units='', default=1) - allocate( CS%WaveNum_Cen(1:CS%NumBands) ) - CS%WaveNum_Cen(:) = 0.0 - allocate( CS%PrescribedSurfStkX(1:CS%NumBands)) - CS%PrescribedSurfStkX(:) = 0.0 - allocate( CS%PrescribedSurfStkY(1:CS%NumBands)) - CS%PrescribedSurfStkY(:) = 0.0 - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:CS%NumBands)) - CS%STKx0(:,:,:) = 0.0 - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:CS%NumBands)) - CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(1:CS%NumBands), source=0.0 ) + allocate( CS%PrescribedSurfStkX(1:CS%NumBands), source=0.0 ) + allocate( CS%PrescribedSurfStkY(1:CS%NumBands), source=0.0 ) + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:CS%NumBands), source=0.0 ) + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:CS%NumBands), source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -409,24 +401,17 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Allocate and initialize ! a. Stokes driftProfiles - allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke)) - CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke)) - CS%Us_y(:,:,:) = 0.0 + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke), source=0.0) ! b. Surface Values - allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) - CS%US0_x(:,:) = 0.0 - allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) - CS%US0_y(:,:) = 0.0 + allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) + allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) ! c. Langmuir number - allocate(CS%La_SL(G%isc:G%iec,G%jsc:G%jec)) - allocate(CS%La_turb(G%isc:G%iec,G%jsc:G%jec)) - CS%La_SL(:,:) = 0.0 - CS%La_turb (:,:) = 0.0 + allocate(CS%La_SL(G%isc:G%iec,G%jsc:G%jec), source=0.0) + allocate(CS%La_turb(G%isc:G%iec,G%jsc:G%jec), source=0.0) ! d. Viscosity for Stokes drift if (CS%StokesMixing) then - allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,GV%ke)) - CS%KvS(:,:,:) = 0.0 + allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,GV%ke), source=0.0) endif ! Initialize Wave related outputs @@ -868,7 +853,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) CS%NUMBANDS = sizes(1) ! Allocate the wavenumber bins - allocate( CS%WaveNum_Cen(CS%NUMBANDS) ) ; CS%WaveNum_Cen(:) = 0.0 + allocate( CS%WaveNum_Cen(CS%NUMBANDS), source=0.0 ) if (wavenumber_exists) then ! Wavenumbers found, so this file uses the old method: @@ -882,7 +867,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) CS%PartitionMode = 1 ! Allocate the frequency bins - allocate( CS%Freq_Cen(CS%NUMBANDS) ) ; CS%Freq_Cen(:) = 0.0 + allocate( CS%Freq_Cen(CS%NUMBANDS), source=0.0 ) ! Reading frequencies PI = 4.0*atan(1.0) @@ -894,10 +879,10 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) endif if (.not.allocated(CS%STKx0)) then - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NUMBANDS) ) ; CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NUMBANDS), source=0.0 ) endif if (.not.allocated(CS%STKy0)) then - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NUMBANDS) ) ; CS%STKy0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NUMBANDS), source=0.0 ) endif endif diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 93a43e4a3e..3f5b8c8ab2 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -239,12 +239,14 @@ end function circ_ridge !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine Neverworld_initialize_thickness(h, G, GV, US, param_file, eqn_of_state, P_ref) +subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, P_ref) 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, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< The thickness that is being !! initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open !! file to parse for model !! parameter values. @@ -283,7 +285,7 @@ subroutine Neverworld_initialize_thickness(h, G, GV, US, param_file, eqn_of_stat enddo do j=js,je ; do i=is,ie - e_interface = -G%bathyT(i,j) + e_interface = -depth_tot(i,j) do k=nz,2,-1 h(i,j,k) = GV%Z_to_H * (e0(k) - e_interface) ! Nominal thickness x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index dfa9c19460..448c86b5fb 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -35,12 +35,14 @@ module Phillips_initialization contains !> Initialize the thickness field for the Phillips model test case. -subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_params) +subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -113,7 +115,7 @@ subroutine Phillips_initialize_thickness(h, G, GV, US, param_file, just_read_par ! thicknesses are set to insure that: 1. each layer is at least an Angstrom thick, and ! 2. the interfaces are where they should be based on the resting depths and interface ! height perturbations, as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(K) = eta_im(j,K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index 4df728c22a..d051bccc6c 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -46,7 +46,7 @@ module RGC_initialization !> 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, US, tv, u, v, PF, use_ALE, CSp, ACSp) +subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, 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. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -59,6 +59,8 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) target, intent(in) :: u !< Array with the u velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & target, intent(in) :: v !< Array with the v velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: PF !< A structure indicating the !! open file to parse for model !! parameter values. @@ -93,10 +95,11 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed iscB = G%iscB ; iecB = G%iecB; jscB = G%jscB ; jecB = G%jecB - call get_param(PF,mod,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) + call get_param(PF, mod,"MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & + units='m', default=1.e-3) - call get_param(PF, mod, "RGC_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', & - default=0.0, scale=86400.0*US%s_to_T) + call get_param(PF, mod, "RGC_TNUDG", TNUDG, 'Nudging time scale for sponge layers', & + units='days', default=0.0, scale=86400.0*US%s_to_T) call get_param(PF, mod, "LENLAT", lenlat, & "The latitudinal or y-direction length of the domain", & @@ -114,7 +117,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) "Nudge velocities (u and v) towards zero in the sponge layer.", & default=.false., do_not_log=.true.) - T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 + T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 ; RHO(:,:,:) = 0.0 call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) @@ -130,7 +133,7 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, PF, use_ALE, CSp, ACSp) ! and mask2dT is 1. do i=is,ie ; do j=js,je - if ((G%bathyT(i,j) <= min_depth) .or. (G%geoLonT(i,j) <= lensponge)) then + if ((depth_tot(i,j) <= min_depth) .or. (G%geoLonT(i,j) <= lensponge)) then Idamp(i,j) = 0.0 elseif (G%geoLonT(i,j) >= (lenlon - lensponge) .AND. G%geoLonT(i,j) <= lenlon) then dummy1 = (G%geoLonT(i,j)-(lenlon - lensponge))/(lensponge) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index ad4eab33ff..b9f676dc55 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -57,8 +57,8 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -193,13 +193,15 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity in the adjustment test case -subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file, & +subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, param_file, & eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. @@ -260,7 +262,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, G, GV, param_file case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA ) dSdz = -delta_S_strat / G%max_depth do j=js,je ; do i=is,ie - eta1d(nz+1) = -G%bathyT(i,j) + eta1d(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1d(k) = eta1d(k+1) + h(i,j,k)*GV%H_to_Z enddo diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index b1c988e016..22f4d705a1 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -75,7 +75,7 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, end subroutine bcz_params !> Initialization of temperature and salinity with the baroclinic zone initial conditions -subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_file, & +subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, US, param_file, & just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -83,6 +83,8 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< The model thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing T & S. @@ -109,7 +111,7 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, GV, US, param_f PI = 4.*atan(1.) do j = G%jsc,G%jec ; do i = G%isc,G%iec - zi = -G%bathyT(i,j) + zi = -depth_tot(i,j) x = G%geoLonT(i,j) - (G%west_lon + 0.5*G%len_lon) ! Relative to center of domain xd = x / G%len_lon ! -1/2 < xd 1/2 y = G%geoLatT(i,j) - (G%south_lat + 0.5*G%len_lat) ! Relative to center of domain diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index ed0bbbf069..d077e0fa6f 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -82,13 +82,15 @@ end subroutine benchmark_initialize_topography !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state, & +subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, eqn_of_state, & P_Ref, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state structure @@ -181,7 +183,7 @@ subroutine benchmark_initialize_thickness(h, G, GV, US, param_file, eqn_of_state ! are set to insure that: 1. each layer is at least Gv%Angstrom_m thick, and ! 2. the interfaces are where they should be based on the resting depths and interface ! height perturbations, as long at this doesn't interfere with 1. - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,2,-1 T_int = 0.5*(T0(k) + T0(k-1)) diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 4dd5a7c606..29fb6647b3 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -28,11 +28,13 @@ module circle_obcs_initialization contains !> This subroutine initializes layer thicknesses for the circle_obcs experiment. -subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_params) +subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -79,8 +81,8 @@ subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_para enddo ! Uniform thicknesses for base state - do j=js,je ; do i=is,ie ! - eta1D(nz+1) = -G%bathyT(i,j) + do j=js,je ; do i=is,ie + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(K) = e0(K) if (eta1D(K) < (eta1D(K+1) + GV%Angstrom_Z)) then diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index e8fe345bb0..c1eb4fa2e7 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -152,11 +152,13 @@ subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, j end subroutine dense_water_initialize_TS !> Initialize the restoring sponges for the dense water experiment -subroutine dense_water_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, ACSp) +subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: use_ALE !< ALE flag type(sponge_CS), pointer :: CSp !< Layered sponge control structure pointer @@ -234,7 +236,7 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CS do j = G%jsc,G%jec do i = G%isc,G%iec - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k = nz,1,-1 eta1D(k) = e0(k) diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index f7b647dd27..463fe018b0 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -90,12 +90,14 @@ subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) end subroutine dumbbell_initialize_topography !> Initializes the layer thicknesses to be uniform in the dumbbell test case -subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_params) +subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -169,7 +171,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then @@ -184,7 +186,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -199,7 +201,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, US, param_file, just_read_p case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * depth_tot(i,j) / dfloat(nz) enddo ; enddo end select @@ -284,11 +286,13 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, param_file end subroutine dumbbell_initialize_temperature_salinity !> Initialize the restoring sponges for the dumbbell test case -subroutine dumbbell_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, ACSp) +subroutine dumbbell_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_ALE, CSp, ACSp) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure logical, intent(in) :: use_ALE !< ALE flag type(sponge_CS), pointer :: CSp !< Layered sponge control structure pointer @@ -354,7 +358,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, if (use_ALE) then ! construct a uniform grid for the sponge do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = depth_tot(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index ea27d01cdc..693d2b5ceb 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -235,7 +235,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) CS%Flux_const = CS%Flux_const / 86400.0 - allocate(CS%forcing_mask(G%isd:G%ied, G%jsd:G%jed)); CS%forcing_mask(:,:)=0.0 + allocate(CS%forcing_mask(G%isd:G%ied, G%jsd:G%jed), source=0.0) allocate(CS%S_restore(G%isd:G%ied, G%jsd:G%jed)) do j=G%jsc,G%jec diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 9118133108..6bfaedc221 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -77,12 +77,14 @@ end subroutine seamount_initialize_topography !> Initialization of thicknesses. !! This subroutine initializes the layer thicknesses to be uniform. -subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_params) +subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -152,7 +154,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom enddo do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = e0(k) if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then @@ -167,7 +169,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) + eta1D(nz+1) = -depth_tot(i,j) do k=nz,1,-1 eta1D(k) = -G%max_depth * real(k-1) / real(nz) if (eta1D(k) < (eta1D(k+1) + min_thickness)) then @@ -182,7 +184,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, US, param_file, just_read_p case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie - h(i,j,:) = GV%Z_to_H * G%bathyT(i,j) / dfloat(nz) + h(i,j,:) = GV%Z_to_H * depth_tot(i,j) / dfloat(nz) enddo ; enddo end select diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index e1c0a96d63..1c3334d8b0 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -53,12 +53,14 @@ end subroutine sloshing_initialize_topography !! same thickness but all interfaces (except bottom and sea surface) are !! displaced according to a half-period cosine, with maximum value on the !! left and minimum value on the right. This sets off a regular sloshing motion. -subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_params) +subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] 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 @@ -152,7 +154,7 @@ subroutine sloshing_initialize_thickness ( h, G, GV, US, param_file, just_read_p enddo ! 3. The last interface must coincide with the seabed - z_inter(nz+1) = -G%bathyT(i,j) + z_inter(nz+1) = -depth_tot(i,j) ! Modify interface heights to make sure all thicknesses are strictly positive do k = nz,1,-1 if ( z_inter(k) < (z_inter(k+1) + GV%Angstrom_Z) ) then diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index ac6ec8c4bc..f62aa54f88 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -28,12 +28,14 @@ module soliton_initialization contains !> Initialization of thicknesses in Equatorial Rossby soliton test -subroutine soliton_initialize_thickness(h, G, GV, US) +subroutine soliton_initialize_thickness(h, depth_tot, 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. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] integer :: i, j, k, is, ie, js, je, nz real :: x, y, x0, y0 @@ -55,7 +57,7 @@ subroutine soliton_initialize_thickness(h, G, GV, US) y = G%geoLatT(i,j)-y0 val3 = exp(-val1*x) val4 = val2 * ( 2.0*val3 / (1.0 + (val3*val3)) )**2 - h(i,j,k) = GV%Z_to_H * (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + G%bathyT(i,j)) + h(i,j,k) = GV%Z_to_H * (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + depth_tot(i,j)) enddo enddo ; enddo diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 793b87f149..3338121d9e 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -247,7 +247,7 @@ end subroutine write_user_log !! - u - Zonal velocity [Z T-1 ~> m s-1]. !! - v - Meridional velocity [Z T-1 ~> m s-1]. !! - h - Layer thickness [H ~> m or kg m-2]. (Must be positive.) -!! - G%bathyT - Basin depth [Z ~> m]. (Must be positive.) +!! - G%bathyT - Basin depth [Z ~> m]. !! - G%CoriolisBu - The Coriolis parameter [T-1 ~> s-1]. !! - GV%g_prime - The reduced gravity at each interface [L2 Z-1 T-2 ~> m s-2]. !! - GV%Rlay - Layer potential density (coordinate variable) [R ~> kg m-3].