diff --git a/.github/actions/macos-setup/action.yml b/.github/actions/macos-setup/action.yml index 197a2d83c8..fecbe787b5 100644 --- a/.github/actions/macos-setup/action.yml +++ b/.github/actions/macos-setup/action.yml @@ -10,7 +10,7 @@ runs: shell: bash run: | echo "::group::Install packages" - brew update + brew reinstall gcc brew install automake brew install netcdf brew install netcdf-fortran diff --git a/.github/actions/testing-setup/action.yml b/.github/actions/testing-setup/action.yml index 8a3264b140..6ba149d927 100644 --- a/.github/actions/testing-setup/action.yml +++ b/.github/actions/testing-setup/action.yml @@ -5,10 +5,6 @@ inputs: description: 'If true, will build the symmetric MOM6 executable' required: false default: 'true' - install_python: - description: 'If true, will install the local python env needed for .testing' - required: false - default: 'true' runs: using: 'composite' steps: @@ -54,14 +50,6 @@ runs: test ${{ inputs.build_symmetric }} == true && make build/symmetric/MOM6 -j echo "::endgroup::" - - name: Install local python venv for generating input data - shell: bash - run: | - echo "::group::Create local python env for input data generation" - cd .testing - test ${{ inputs.install_python }} == true && make work/local-env - echo "::endgroup::" - - name: Set flags shell: bash run: | diff --git a/.github/workflows/coupled-api.yml b/.github/workflows/coupled-api.yml index 443755c7f4..2c9fa32720 100644 --- a/.github/workflows/coupled-api.yml +++ b/.github/workflows/coupled-api.yml @@ -20,7 +20,6 @@ jobs: - uses: ./.github/actions/testing-setup with: build_symmetric: 'false' - install_python: 'false' - name: Compile MOM6 for the GFDL coupled driver shell: bash diff --git a/.github/workflows/macos-regression.yml b/.github/workflows/macos-regression.yml index d975854e0c..dc86a52212 100644 --- a/.github/workflows/macos-regression.yml +++ b/.github/workflows/macos-regression.yml @@ -8,8 +8,8 @@ jobs: runs-on: macOS-latest env: - CC: gcc-11 - FC: gfortran-11 + CC: gcc + FC: gfortran defaults: run: diff --git a/.github/workflows/macos-stencil.yml b/.github/workflows/macos-stencil.yml index 33436c221f..96240f31f8 100644 --- a/.github/workflows/macos-stencil.yml +++ b/.github/workflows/macos-stencil.yml @@ -8,8 +8,8 @@ jobs: runs-on: macOS-latest env: - CC: gcc-11 - FC: gfortran-11 + CC: gcc + FC: gfortran defaults: run: diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 496a578c91..653734097b 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -6,124 +6,72 @@ stages: - cleanup # JOB_DIR points to a persistent working space used for most stages in this pipeline but -# it is unique to this pipeline. +# that is unique to this pipeline. # We use the "fetch" strategy to speed up the startup of stages variables: JOB_DIR: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/builds/$CI_PIPELINE_ID" + WORKSPACE: "/lustre/f2/scratch/oar.gfdl.ogrp-account/runner/$CI_RUNNER_ID" GIT_STRATEGY: fetch -# Start all stages in $JOB_DIR/.../MOM6-examples -# Exception: for "setup" stages MOM6-examples has not yet been cloned so the stage starts in $JOB_DIR +# Always eport value of $JOB_DIR before_script: - - echo -e "\e[0Ksection_start:`date +%s`:dir_stuff[collapsed=true]\r\e[0KChanging directories to $JOB_DIR" - echo Job directory set to $JOB_DIR - - mkdir -p $JOB_DIR - - cd $JOB_DIR - - test -d Gaea-stats-MOM6-examples/MOM6-examples && cd Gaea-stats-MOM6-examples/MOM6-examples - - pwd - - echo -e "\e[0Ksection_end:`date +%s`:dir_stuff\r\e[0K" # Test that merge with dev/gfdl works. -merge: +p:merge: stage: setup tags: - ncrc4 script: - - cd $CI_PROJECT_DIR - git pull --no-edit https://github.com/NOAA-GFDL/MOM6.git dev/gfdl # Setup the persistent JOB_DIR for all subsequent stages # -# This basically setups up a complete tree much as a user would work -# EXCEPT that src/MOM6 is cloned from a file system -clone: +# This basically setups up a complete tree much as a user would in their workflow +p:clone: stage: setup tags: - ncrc4 - before_script: - - echo -e "\e[0Ksection_start:`date +%s`:dir_stuff[collapsed=true]\r\e[0KChanging directories to $JOB_DIR" - - cd $CI_PROJECT_DIR - - git submodule init ; git submodule update - - echo Job directory set to $JOB_DIR - - mkdir -p $JOB_DIR - - cd $JOB_DIR - - test -d Gaea-stats-MOM6-examples && rm -rf Gaea-stats-MOM6-examples # In case we are re-running this stage - - pwd - - echo -e "\e[0Ksection_end:`date +%s`:dir_stuff\r\e[0K" - script: - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCloning repository tree" - - git clone https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git - - cd Gaea-stats-MOM6-examples - - git submodule update --init - - cd MOM6-examples - - git checkout dev/gfdl - - git submodule init - - git submodule set-url src/MOM6 $CI_PROJECT_DIR/.git # Easiest way to get MOM6 source to be tested - - git submodule update --recursive --jobs 8 - - (cd src/MOM6 ; git checkout $CI_COMMIT_SHA ; git submodule update --recursive --init) # Get commit to be tested - - make -f tools/MRS/Makefile.clone clone_gfdl -j # Extras and link to datasets - - bash tools/MRS/generate_manifest.sh . tools/MRS/excluded-expts.txt > manifest.mk - - mkdir -p results - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + script: + - .gitlab/pipeline-ci-tool.sh create-job-dir +#.gitlab/pipeline-ci-tool.sh clean-job-dir # Make work spaces for running simultaneously in parallel jobs # # Each work space is a clone of MOM6-examples with symbolic links for the build and data directories # so they can share executables which can run simultaneously without interfering with each other -work-space:pgi: +s:work-space:pgi: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-pgi-MOM6-examples - - cd tmp-pgi-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space pgi -work-space:intel: +s:work-space:intel: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-intel-MOM6-examples - - cd tmp-intel-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space intel -work-space:gnu: +s:work-space:gnu: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-gnu-MOM6-examples - - cd tmp-gnu-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space gnu -work-space:gnu-restarts: +s:work-space:gnu-restarts: stage: setup tags: - ncrc4 - needs: ["clone"] + needs: ["p:clone"] script: - - echo -e "\e[0Ksection_start:`date +%s`:clone[collapsed=true]\r\e[0KCreating separate work space" - - git clone -s .git tmp-gnu-restarts-MOM6-examples - - cd tmp-gnu-restarts-MOM6-examples - - ln -s ../{build,results,.datasets} . - - cp ../manifest.mk . - - echo -e "\e[0Ksection_end:`date +%s`:clone\r\e[0K" + - .gitlab/pipeline-ci-tool.sh copy-test-space gnu-rst # Compile executables # @@ -132,140 +80,97 @@ work-space:gnu-restarts: compile:pgi:repro: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_pgi" - - time make -f tools/MRS/Makefile.build repro_pgi -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile repro_pgi compile:intel:repro: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_intel" - - time make -f tools/MRS/Makefile.build repro_intel -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile repro_intel compile:gnu:repro: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target repro_gnu" - - time make -f tools/MRS/Makefile.build repro_gnu -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - echo -e "\e[0Ksection_start:`date +%s`:compile2[collapsed=true]\r\e[0KCompiling target static_gnu" - - time make -f tools/MRS/Makefile.build static_gnu -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile2\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile repro_gnu mrs-compile static_gnu compile:gnu:debug: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo -e "\e[0Ksection_start:`date +%s`:compile2[collapsed=true]\r\e[0KCompiling target debug_gnu" - - time make -f tools/MRS/Makefile.build debug_gnu -s -j - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh mrs-compile debug_gnu compile:gnu:ocean-only-nolibs: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ocean-only no-libs" - - mkdir -p build-ocean-only-nolibs - - cd build-ocean-only-nolibs - - make -f ../tools/MRS/Makefile.build ./gnu/env BUILD=. -s - - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 - - sed -i '/FMS1\/.*\/test_/d' path_names - - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names - - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh nolibs-ocean-only-compile gnu compile:gnu:ice-ocean-nolibs: stage: builds - needs: ["clone"] + needs: ["p:clone"] tags: - ncrc4 script: - - echo 911 - - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling target gnu ice-ocean-SIS2 no-libs" - - mkdir -p build-ice-ocean-SIS2-nolibs - - cd build-ice-ocean-SIS2-nolibs - - make -f ../tools/MRS/Makefile.build ./gnu/env BUILD=. -s - - ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} - - sed -i '/FMS1\/.*\/test_/d' path_names - - ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-gnu.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names - - (source gnu/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) - - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" + - .gitlab/pipeline-ci-tool.sh nolibs-ocean-ice-compile gnu # Runs -# -# The main "run" stage uses the script .gitlab/mom6-ci-run-script.sh run:pgi: stage: run - needs: ["work-space:pgi","compile:pgi:repro"] + needs: ["s:work-space:pgi","compile:pgi:repro"] tags: - ncrc4 script: - - cd tmp-pgi-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-pgi-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-pgi-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-PGI-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_pgi_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite pgi SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-pgi-SNL || ( echo Batch job did not complete ; exit 911 ) run:intel: stage: run - needs: ["work-space:intel","compile:intel:repro"] + needs: ["s:work-space:intel","compile:intel:repro"] tags: - ncrc4 script: - - echo 911 - - cd tmp-intel-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-intel-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-intel-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-INTEL-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_intel_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite intel SNL && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-intel-SNL || ( echo Batch job did not complete ; exit 911 ) run:gnu: stage: run - needs: ["work-space:gnu","compile:gnu:repro","compile:gnu:debug"] + needs: ["s:work-space:gnu","compile:gnu:repro","compile:gnu:debug"] tags: - ncrc4 script: - - cd tmp-gnu-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-gnu-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait mom6-ci-run-gnu-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-GNU-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_tests --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu SNLDT && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-SNLDT || ( echo Batch job did not complete ; exit 911 ) run:gnu-restarts: stage: run - needs: ["work-space:gnu","compile:gnu:repro"] + needs: ["s:work-space:gnu-restarts","compile:gnu:repro"] tags: - ncrc4 script: - - echo 911 - - cd tmp-gnu-restarts-MOM6-examples - - cp ../src/MOM6/.gitlab/mom6-ci-run-gnu-restarts-script.sh . - - sbatch --clusters=c3,c4 --nodes=30 --time=0:20:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait mom6-ci-run-gnu-restarts-script.sh && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) - - test -f .CI-GNU-RESTARTS-BATCH-SUCCESS || ( echo Batch job did not complete ; exit 911 ) - - git checkout . # reset working space so we can use it to compare against + - sbatch --clusters=c3,c4 --nodes=30 --time=1:00:00 --account=gfdl_o --qos=debug --job-name=mom6_gnu_restarts --output=log.$CI_JOB_ID --wait .gitlab/pipeline-ci-tool.sh run-suite gnu R && ( egrep -v 'pagefaults|HiWaterMark=' log.$CI_JOB_ID ; echo Job returned normally ) || ( cat log.$CI_JOB_ID ; echo Job failed ; exit 911 ) + - test -f $JOB_DIR/CI-BATCH-SUCCESS-gnu-R || ( echo Batch job did not complete ; exit 911 ) -# These "run" stages replace the "before_script" and so start in the transient work-space provided by gitlab +# GH/autoconf tests (duplicates the GH actions tests) +# +# These stages replace the "before_script" and so start in the transient work-space provided by gitlab. # We work here to avoid collisions with parallel jobs -gnu.testing: - stage: run +actions:gnu: + stage: tests needs: [] tags: - ncrc4 @@ -277,14 +182,15 @@ gnu.testing: - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling executables" - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan ; module load PrgEnv-gnu ; module unload netcdf gcc ; module load gcc/7.3.0 cray-hdf5 cray-netcdf - - make work/local-env - make -s -j + - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || cat log.$CI_JOB_ID + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s + - make WORKSPACE=$WORKSPACE test.summary -intel.testing: - stage: run +actions:intel: + stage: tests needs: [] tags: - ncrc4 @@ -296,11 +202,12 @@ intel.testing: - echo -e "\e[0Ksection_start:`date +%s`:compile[collapsed=true]\r\e[0KCompiling executables" - cd .testing - module unload PrgEnv-pgi PrgEnv-intel PrgEnv-gnu darshan; module load PrgEnv-intel; module unload netcdf intel; module load intel/18.0.6.288 cray-hdf5 cray-netcdf - - make work/local-env - make -s -j + - MPIRUN= make preproc -s -j - echo -e "\e[0Ksection_end:`date +%s`:compile\r\e[0K" - - (echo '#!/bin/bash';echo '. ./work/local-env/bin/activate';echo 'make MPIRUN="srun -mblock --exclusive" test -s -j') > job.sh - - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.gnu.testing --output=log.$CI_JOB_ID --wait job.sh && make test || cat log.$CI_JOB_ID + - (echo '#!/bin/bash';echo 'make MPIRUN="srun -mblock --exclusive" WORKSPACE=$WORKSPACE test -s -j') > job.sh + - sbatch --clusters=c3,c4 --nodes=5 --time=0:05:00 --account=gfdl_o --qos=debug --job-name=MOM6.intel.testing --output=log.$CI_JOB_ID --wait job.sh || ( cat log.$CI_JOB_ID ; exit 911 ) && make WORKSPACE=$WORKSPACE test -s + - make WORKSPACE=$WORKSPACE test.summary # Tests # @@ -313,7 +220,7 @@ t:pgi:symmetric: tags: - ncrc4 script: - - ( cd results/pgi_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats pgi S t:pgi:non-symmetric: stage: tests @@ -321,7 +228,7 @@ t:pgi:non-symmetric: tags: - ncrc4 script: - - ( cd results/pgi_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats pgi N t:pgi:layout: stage: tests @@ -329,7 +236,7 @@ t:pgi:layout: tags: - ncrc4 script: - - ( cd results/pgi_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats pgi L t:pgi:params: stage: tests @@ -337,7 +244,7 @@ t:pgi:params: tags: - ncrc4 script: - - ( cd results/pgi_params/ ; md5sum `find * -type f` ) | md5sum -c + - .gitlab/pipeline-ci-tool.sh check-params pgi allow_failure: true t:intel:symmetric: @@ -346,7 +253,7 @@ t:intel:symmetric: tags: - ncrc4 script: - - ( cd results/intel_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats intel S t:intel:non-symmetric: stage: tests @@ -354,7 +261,7 @@ t:intel:non-symmetric: tags: - ncrc4 script: - - ( cd results/intel_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats intel N t:intel:layout: stage: tests @@ -362,7 +269,7 @@ t:intel:layout: tags: - ncrc4 script: - - ( cd results/intel_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats intel L t:intel:params: stage: tests @@ -370,7 +277,7 @@ t:intel:params: tags: - ncrc4 script: - - ( cd results/intel_params/ ; md5sum `find * -type f` ) | md5sum -c + - .gitlab/pipeline-ci-tool.sh check-params intel allow_failure: true t:gnu:symmetric: @@ -379,7 +286,7 @@ t:gnu:symmetric: tags: - ncrc4 script: - - ( cd results/gnu_all_sym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu S t:gnu:non-symmetric: stage: tests @@ -387,7 +294,7 @@ t:gnu:non-symmetric: tags: - ncrc4 script: - - ( cd results/gnu_all_nonsym/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu N t:gnu:layout: stage: tests @@ -395,7 +302,7 @@ t:gnu:layout: tags: - ncrc4 script: - - ( cd results/gnu_all_layout/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu L t:gnu:static: stage: tests @@ -403,7 +310,7 @@ t:gnu:static: tags: - ncrc4 script: - - ( cd results/gnu_all_static/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu T t:gnu:symmetric-debug: stage: tests @@ -411,7 +318,7 @@ t:gnu:symmetric-debug: tags: - ncrc4 script: - - ( cd results/gnu_ocean_only_debug/ ; md5sum `find * -type f` ) | ( cd ../regressions/ ; md5sum -c ) + - .gitlab/pipeline-ci-tool.sh check-stats gnu D t:gnu:restart: stage: tests @@ -419,9 +326,7 @@ t:gnu:restart: tags: - ncrc4 script: - - cd tmp-gnu-restarts-MOM6-examples - - ( cd ../results/gnu_restarts ; tar cf - * ) | tar xf - # NOTE this unpacks in tmp-gnu-restarts-MOM6-examples (not a new directory) - - make -f tools/MRS/Makefile.restart restart_gnu_ocean_only restart_gnu_ice_ocean_SIS2 -s -k + - .gitlab/pipeline-ci-tool.sh check-stats gnu R t:gnu:params: stage: tests @@ -429,7 +334,16 @@ t:gnu:params: tags: - ncrc4 script: - - ( cd results/gnu_params/ ; md5sum `find * -type f` ) | md5sum -c + - .gitlab/pipeline-ci-tool.sh check-params gnu + allow_failure: true + +t:gnu:diags: + stage: tests + needs: ["run:gnu"] + tags: + - ncrc4 + script: + - .gitlab/pipeline-ci-tool.sh check-diags gnu allow_failure: true # We cleanup ONLY if the preceding stages were completed successfully diff --git a/.gitlab/README.md b/.gitlab/README.md new file mode 100644 index 0000000000..6e11900f9e --- /dev/null +++ b/.gitlab/README.md @@ -0,0 +1,148 @@ +# CI script pipeline-ci-tool.sh + +pipeline-ci-tool.sh contains functions corresponding to each job within the gitlab CI pipeline for MOM6 at GFDL, specifically on the gaea HPC. +Each function can be run by a parser function so that the functions can be invoked from the command line or a shell. +Some functions take arguments. +Encapsulating the job commands in a function allows us to develop/debug the pipeline by issuing the same, relatively short, commands at the command line. + +pipeline-ci-tool.sh relies on three environment variables to execute. They are mandatory. + - JOB_DIR is a scratch location that will be created and populated + - CI_PROJECT_DIR is normally set by gitlab and will point to the working directory where MOM6 is cloned + - CI_COMMIT_SHA is the commit of MOM6 to be tested + +To use pipeline-ci-tool.sh interactively from an existing MOM6 clone, you could use + `JOB_DIR=tmp CI_PROJECT_DIR=. CI_COMMIT_SHA=`git rev-parse HEAD` .gitlab/pipeline-ci-tool.sh ...` +This will use the HEAD commit in the current working dir and setup an independent test suite under tmp/. + +## Usage + `pipeline-ci-tool.sh FUNCTION [-x|+x] [-n|+n] [ARG1] [ARG2] [...]` + `pipeline-ci-tool.sh FUNCTION [-x|+x] [-n|+n] [ARG1] [ARG2] [[-x|+x] [-n|+n] FUNCTION [ARG1] [ARG2] [...]] [...]` + +FUNCTION can be one of + - `create-job-dir` : Create a "job directory" using the environment variable JOB_DIR. This is a where all the compilation and running takes place. + - `clean-job-dir` : Not used by .gitlab-ci.yml but useful for resetting an interactive session. + - `copy-test-space LABEL` : Within $JOB_DIR, clones MOM6-examples to tmp-MOM6-examples-LABEL to use as a workspace for tests + - `mrs-compile TARGET` : Invokes tools/MRS/Makefile.build to build MODE_VENDER. VENDER can be gnu, intel, or pgi. MODE can be repro, debug, static, etc. + - `nolibs-ocean-only-compile VENDER` : Compiles the "no libraries" executables. These are not used elsewhere in the CI but check we have no namespace problems. VENDER can be gnu, intel, or pgi. + - `run-suite VENDER CODE` : runs subsets of the MOM6-examples according to CODE using the VENDER executables. CODE is a string of the characters S (symmetric), N (non-symmetric), L (layout), D (debug), or R (restart), and if present executes the corresponding tests. + - `check-stats VENDER CODE` : check the stats files for the corresponding VENDOR/CODE resulting from run-suite + - `check-params VENDER CODE` : check the parameter documentation files for the corresponding VENDOR/CODE resulting from run-suite + - `check-diags VENDER CODE` : check the available diagnostics files for the corresponding VENDOR/CODE resulting from run-suite + +Options: + - `-x` : shows commands as they are executed. `+x` turns back to silent executions. You can precede each function as needed so that only commands from selected functions are shown. + - `-n` : for many function, disables all functionality and simply prints the banner that each sections was reached. `+n` turns the functions back on. + +## Correspondance to jobs in .gitlab-ci.yml + +The .gitlab-ci.yml jobs names and pipeline-ci-tool.sh commands are: + + clone: + `pipeline-ci-tool.sh create-job-dir` + + work-space:pgi: + `pipeline-ci-tool.sh copy-test-space pgi` + + work-space:intel: + `pipeline-ci-tool.sh copy-test-space intel` + + work-space:gnu: + `pipeline-ci-tool.sh copy-test-space gnu` + + work-space:gnu-restarts: + `pipeline-ci-tool.sh copy-test-space gnu-rst` + + compile:pgi:repro: + `pipeline-ci-tool.sh mrs-compile repro_pgi` + + compile:intel:repro: + `pipeline-ci-tool.sh mrs-compile repro_intel` + + compile:gnu:repro: + `pipeline-ci-tool.sh mrs-compile repro_gnu mrs-compile static_gnu` + + compile:gnu:debug: + `pipeline-ci-tool.sh mrs-compile debug_gnu` + + compile:gnu:ocean-only-nolibs: + `pipeline-ci-tool.sh nolibs-ocean-only-compile gnu` + + compile:gnu:ice-ocean-nolibs: + `pipeline-ci-tool.sh nolibs-ocean-ice-compile gnu` + + run:pgi: + `pipeline-ci-tool.sh run-suite pgi SNL` + + run:intel: + `pipeline-ci-tool.sh run-suite intel SNL` + + run:gnu: + `pipeline-ci-tool.sh run-suite gnu SNLD` + + run:gnu-restarts: + `pipeline-ci-tool.sh run-suite gnu R` + + t:pgi:symmetric: + `pipeline-ci-tool.sh check-stats pgi S` + + t:pgi:non-symmetric: + `pipeline-ci-tool.sh check-stats pgi N` + + t:pgi:layout: + `pipeline-ci-tool.sh check-stats pgi L` + + t:pgi:params: + `pipeline-ci-tool.sh check-params pgi S` + + t:intel:symmetric: + `pipeline-ci-tool.sh check-stats intel S` + + t:intel:non-symmetric: + `pipeline-ci-tool.sh check-stats intel N` + + t:intel:layout: + `pipeline-ci-tool.sh check-stats intel L` + + t:intel:params: + `pipeline-ci-tool.sh check-params intel S` + + t:gnu:symmetric: + `pipeline-ci-tool.sh check-stats gnu S` + + t:gnu:non-symmetric: + `pipeline-ci-tool.sh check-stats gnu N` + + t:gnu:layout: + `pipeline-ci-tool.sh check-stats gnu L` + + t:gnu:static: + `pipeline-ci-tool.sh check-stats gnu T` + + t:gnu:symmetric-debug: + `pipeline-ci-tool.sh check-stats gnu D` + + t:gnu:restart: + `pipeline-ci-tool.sh check-stats gnu R` + + t:gnu:params: + `pipeline-ci-tool.sh check-params gnu S` + + t:gnu:diags: + `pipeline-ci-tool.sh check-diags gnu S` + +### Duplicating the pipeline interactively + +You can run a sequence of commands as follows. The setup and compile phases of the CI pipeline can be summarized with +``` +pipeline-ci-tool.sh create-job-dir copy-test-space pgi copy-test-space intel copy-test-space gnu copy-test-space gnu-rst mrs-compile repro_pgi mrs-compile repro_intel mrs-compile repro_gnu mrs-compile static_gnu mrs-compile debug_gnu nolibs-ocean-only-compile gnu nolibs-ocean-ice-compile gnu +``` + +The run stage (works on compute nodes only) can be summarized with: +``` +pipeline-ci-tool.sh run-suite pgi SNL run-suite intel SNL run-suite gnu SNLDT run-suite gnu R +``` + +The test stage is summarized by: +``` +pipeline-ci-tool.sh check-stats pgi S check-stats pgi N check-stats pgi L check-params pgi S check-stats intel S check-stats intel N check-stats intel L check-params intel S check-stats gnu S check-stats gnu N check-stats gnu L check-stats gnu T check-stats gnu D check-stats gnu R check-params gnu S check-diags gnu S +``` diff --git a/.gitlab/mom6-ci-run-gnu-script.sh b/.gitlab/mom6-ci-run-gnu-script.sh index 82e37abc5e..8577eff6d2 100644 --- a/.gitlab/mom6-ci-run-gnu-script.sh +++ b/.gitlab/mom6-ci-run-gnu-script.sh @@ -34,7 +34,7 @@ set -v section_start gnu_all_sym "Running symmetric gnu" time make -f tools/MRS/Makefile.run gnu_all -s -j tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/gnu_all_sym -xf - -tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/gnu_params -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/gnu_params -xf - check_for_core_files section_end diff --git a/.gitlab/mom6-ci-run-intel-script.sh b/.gitlab/mom6-ci-run-intel-script.sh index c5a361a202..875d60c191 100644 --- a/.gitlab/mom6-ci-run-intel-script.sh +++ b/.gitlab/mom6-ci-run-intel-script.sh @@ -34,7 +34,7 @@ set -v section_start intel_all_sym "Running symmetric intel" time make -f tools/MRS/Makefile.run intel_all -s -j tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/intel_all_sym -xf - -tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/intel_params -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/intel_params -xf - check_for_core_files section_end diff --git a/.gitlab/mom6-ci-run-pgi-script.sh b/.gitlab/mom6-ci-run-pgi-script.sh index 98ba9a08c3..27216e4a9f 100644 --- a/.gitlab/mom6-ci-run-pgi-script.sh +++ b/.gitlab/mom6-ci-run-pgi-script.sh @@ -34,7 +34,7 @@ set -v section_start pgi_all_sym "Running symmetric pgi" time make -f tools/MRS/Makefile.run pgi_all -s -j tar cf - `find [oicl]* -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/pgi_all_sym -xf - -tar cf - `find [oicl]* -name "*_parameter_doc.*"` | tar --one-top-level=results/pgi_params -xf - +tar cf - `find [oicl]* -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/pgi_params -xf - check_for_core_files section_end diff --git a/.gitlab/pipeline-ci-tool.sh b/.gitlab/pipeline-ci-tool.sh new file mode 100755 index 0000000000..641e9f6053 --- /dev/null +++ b/.gitlab/pipeline-ci-tool.sh @@ -0,0 +1,444 @@ +#!/bin/bash + +# Environment variables set by gitlab (the CI environment) +if [ -z $JOB_DIR ]; then + echo Environment variable "$"JOB_DIR should be defined to point to a unique directory for these scripts to use. + echo '$JOB_DIR is derived from $CI_PIPELINE_ID in MOM6/.gitlab-ci.yml' + echo 'To use interactively try:' + echo ' JOB_DIR=tmp' $0 $@ + exit 911 +fi +if [ -z $CI_PROJECT_DIR ]; then + echo Environment variable "$"CI_PROJECT_DIR should be defined and point to where gitlab has cloned the MOM6 repository for this pipeline. + echo 'To use interactively try:' + echo ' CI_PROJECT_DIR=.' $0 $@ + exit 911 +else + CI_PROJECT_DIR=`realpath $CI_PROJECT_DIR` +fi +if [ -z $CI_COMMIT_SHA ]; then + echo Environment variable "$"CI_COMMIT_SHA should be defined and indicate the MOM6 commit to used in this pipeline. + echo 'To use interactively try:' + echo ' CI_COMMIT_SHA=`git rev-parse HEAD`' $0 $@ + exit 911 +fi + +# Use CI=true to enable the gitlab folding + +set -e # Stop if we encounter an error + +# Environment variables that can be set outside +STATS_REPO_URL="${STATS_REPO_URL:-https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git}" +STATS_REPO_BRANCH="${STATS_REPO_BRANCH:-dev/gfdl}" +CONFIGS_DIR="${CONFIGS_DIR:-MOM6-examples}" +CONFIGS_REPO_BRANCH="${CONFIGS_REPO_BRANCH:-$STATS_REPO_BRANCH}" + +# Global variables derived from the above +DRYRUN= +STATS_REPO=$(basename $STATS_REPO_URL) +STATS_REPO_DIR=$(basename $STATS_REPO .git) + +# Static variables +RED=$'\033[1;31m' +GRN=$'\033[1;32m' +OFF=$'\e[m' + +# Print the start of a fold in the log +section-start () { + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=true]\r\e[0K$2" +} + +# Print the start of a fold in the log but not collapsed +section-start-open () { + echo -e "\e[0Ksection_start:`date +%s`:$1[collapsed=false]\r\e[0K$2" +} + +# Print the end of a fold in the log +section-end () { + echo -e "\e[0Ksection_end:`date +%s`:$1\r\e[0K" +} + +# Create $JOB_DIR and clean out any prior work-spaces +# Location: run in MOM6 directory +clean-job-dir () { + section-start clean-job-dir "Cleaning $JOB_DIR directory" + if [ ! $DRYRUN ] ; then + #NOT USED? cd $CI_PROJECT_DIR + #NOT USED? git submodule init ; git submodule update + echo Job directory set to $JOB_DIR + mkdir -p $JOB_DIR + cd $JOB_DIR + test -d $STATS_REPO_DIR && rm -rf $STATS_REPO_DIR # In case we are re-running this stage + fi + section-end clean-job-dir +} + +# Create the full work space starting at the regression repository (usually Gaea-stats-MOM6-examples) +# Location: run in MOM6 directory +create-job-dir () { + section-start create-job-dir "Creating and populating $JOB_DIR" + if [ ! $DRYRUN ] ; then + mkdir -p $JOB_DIR + cd $JOB_DIR + git clone $STATS_REPO_URL $STATS_REPO_DIR + cd $STATS_REPO_DIR + git checkout $STATS_REPO_BRANCH + git submodule update --init + cd $CONFIGS_DIR + git checkout $CONFIGS_REPO_BRANCH + git submodule init + git submodule set-url src/MOM6 $CI_PROJECT_DIR/.git + git submodule update --recursive --jobs 8 + (cd src/MOM6 ; git checkout $CI_COMMIT_SHA) # Get commit to be tested + (cd src/MOM6 ; git submodule update --recursive --init) + make -f tools/MRS/Makefile.clone clone_gfdl -j # Extras and link to datasets + bash tools/MRS/generate_manifest.sh . tools/MRS/excluded-expts.txt > manifest.mk + mkdir -p results + fi + section-end create-job-dir +} + +# Create a copy of the configurations working directory +# Location: run in MOM6 directory +copy-test-space () { + if [ -z $1 ]; then echo "copy-test-space needs an argument" ; exit 911 ; fi + section-start copy-test-space-$1 "Copying $CONFIGS_DIR for $1" + if [ ! $DRYRUN ] ; then + COPIED_DIR=tmp-$CONFIGS_DIR-$1 + cd $JOB_DIR/$STATS_REPO_DIR + git clone -s $CONFIGS_DIR/.git $COPIED_DIR + cd $COPIED_DIR + ln -s ../$CONFIGS_DIR/{build,results,.datasets} . + cp ../$CONFIGS_DIR/manifest.mk . + fi + section-end copy-test-space-$1 +} + +# Build a group of executables using the tools/MRS/Makefile.build template +# Location: run in MOM6 directory +mrs-compile () { + if [ -z $1 ]; then echo "mrs-compile needs an argument" ; exit 911 ; fi + section-start mrs-compile-$1 "Compiling target $1" + if [ ! $DRYRUN ] ; then + cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + time make -f tools/MRS/Makefile.build $1 -s -j + fi + section-end mrs-compile-$1 +} + +# Build an ocean-only executable without intermediate libraries +# Location: run in MOM6 directory +nolibs-ocean-only-compile () { + if [ -z $1 ]; then echo "nolibs-ocean-only-compile needs an argument" ; exit 911 ; fi + section-start nolibs-ocean-only-compile-$1 "Compiling ocean-only $1 executable" + if [ ! $DRYRUN ] ; then + cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + mkdir -p build-ocean-only-nolibs-$1 + cd build-ocean-only-nolibs-$1 + make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s + ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/solo_driver,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/FMS1 + sed -i '/FMS1\/.*\/test_/d' path_names + ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF" path_names + (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + fi + section-end nolibs-ocean-only-compile-$1 +} + +# Build an ocean-ice executable without intermediate libraries +# Location: run in MOM6 directory +nolibs-ocean-ice-compile () { + if [ -z $1 ]; then echo "nolibs-ocean-ice-compile needs an argument" ; exit 911 ; fi + section-start nolibs-ocean-ice-compile-$1 "Compiling ocean-ice $1 executable" + if [ ! $DRYRUN ] ; then + cd $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + mkdir -p build-ocean-ice-nolibs-$1 + cd build-ocean-ice-nolibs-$1 + make -f ../tools/MRS/Makefile.build ./$1/env BUILD=. ENVIRON=../../environ -s + ../src/mkmf/bin/list_paths -l ../src/MOM6/config_src/{drivers/FMS_cap,memory/dynamic_symmetric,infra/FMS1,ext*} ../src/MOM6/src ../src/SIS2/*src ../src/{FMS1,coupler,icebergs,ice_param,land_null,atmos_null} + sed -i '/FMS1\/.*\/test_/d' path_names + ../src/mkmf/bin/mkmf -t ../src/mkmf/templates/ncrc-$1.mk -p MOM6 -c"-Duse_libMPI -Duse_netCDF -D_USE_LEGACY_LAND_ -Duse_AM3_physics" path_names + (source $1/env ; make NETCDF=3 REPRO=1 MOM6 -s -j) + fi + section-end nolibs-ocean-ice-compile-$1 +} + +# Internal function to clean up stats files +# Args: list of top level directories to scan +clean-stats () { + find $@ -name "*.stats.*[a-z][a-z][a-z]" -delete +} + +# Internal function to clean up param files +# Args: list of top level directories to scan +clean-params () { + find $@ -name "*_parameter_doc.*" -delete + find $@ -name "*available_diags*" -delete +} + +# Internal function to check for core files +# Args: list of top level directories to scan +check-for-core-files () { + EXIT_CODE=0 + find $@ -name core -type f | grep . && EXIT_CODE=1 + if [[ $EXIT_CODE -gt 0 ]] + then + echo "Error: core files found!" + exit 911 + fi +} + +# Internal function to clean up core files (needed for re-running) +# Args: list of top level directories to scan +clean-core-files () { + find $@ -name core -type f -delete +} + +# Internal function to run a sub-suite and copy results to storage +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +# $2 is sub-suite (_all, _ocean_only, _static_ocean_only, ...) +# $3 is MEMORY macro (dynamic_symmetric, dynamic_nonsymmetric, static) +# $4 is MODE macro (repro, debug) +# $5 is LAYOUT macro (def, alt) +mrs-run-sub-suite () { + if [ "$#" -ne 5 ]; then echo "mrs-run-sub-suite needs 5 arguments" ; exit 911 ; fi + section-start mrs-run-sub-suite-$1-$2-$3-$4-$5 "Running target $1-$2-$3-$4-$5" + EXP_GROUPS=`grep / manifest.mk | sed 's:/.*::' | uniq` + clean-stats $EXP_GROUPS + clean-params $EXP_GROUPS + clean-core-files $EXP_GROUPS + if [[ "$3" == *"_nonsym"* ]]; then + time make -f tools/MRS/Makefile.run ocean_only/circle_obcs/ocean.stats.$1 MEMORY=${3/_nonsym/_sym} MODE=$4 LAYOUT=$5 -s -j + fi + time make -f tools/MRS/Makefile.run $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j + tar cf - `find $EXP_GROUPS -name "*.stats.*[a-z][a-z][a-z]"` | tar --one-top-level=results/$1-$2-$3-$4-$5-stats -xf - + tar cf - `find $EXP_GROUPS -name "*_parameter_doc.*" -o -name "*available_diags*"` | tar --one-top-level=results/$1-$2-$3-$4-$5-params -xf - + check-for-core-files $EXP_GROUPS + section-end mrs-run-sub-suite-$1-$2-$3-$4-$5 +} + +# Internal function to run restarts on a sub-suite and copy results to storage +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +# $2 is sub-suite (_all, _ocean_only, _static_ocean_only, ...) +# $3 is MEMORY macro (dynamic_symmetric, dynamic_nonsymmetric, static) +# $4 is MODE macro (repro, debug) +# $5 is LAYOUT macro (def, alt) +mrs-run-restarts-sub-suite () { + if [ "$#" -ne 5 ]; then echo "mrs-run-restarts-sub-suite needs 5 arguments" ; exit 911 ; fi + section-start mrs-run-restarts-sub-suite-$1-$2-$3-$4-$5 "Running target $1-$2-$3-$4-$5" + clean-stats $2 + clean-core-files $2 + time make -f tools/MRS/Makefile.restart $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j RESTART_STAGE=01 + check-for-core-files $2 + time make -f tools/MRS/Makefile.restart $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j RESTART_STAGE=02 + check-for-core-files $2 + time make -f tools/MRS/Makefile.restart $1_$2 MEMORY=$3 MODE=$4 LAYOUT=$5 -s -j RESTART_STAGE=12 + check-for-core-files $2 + section-end mrs-run-restarts-sub-suite-$1-$2-$3-$4-$5 +} + +# Run a suite of experiments +# $1 - compiler brand +# $2 - any combination of "SNLDTR" +# S = symmetric +# N = non-symmetric +# L = layout +# D = debug +# R = restarts +run-suite () { + if [ "$#" -ne 2 ]; then echo "run-suite needs 2 arguments" ; exit 911 ; fi + section-start run-suite-$1-$2 "Running suite for $1-$2" + WORK_DIR=tmp-$CONFIGS_DIR-$1 + rm -f $JOB_DIR/CI-BATCH-SUCCESS-$1-$2 + set -e + set -v + + pushd $JOB_DIR/$STATS_REPO_DIR/$WORK_DIR > /dev/null + if [[ "$2" =~ "S" ]]; then # Symmetric + mrs-run-sub-suite $1 all dynamic_symmetric repro def + fi + if [[ "$2" =~ "N" ]]; then # Non-symmetric + mrs-run-sub-suite $1 all dynamic_nonsymmetric repro def + fi + if [[ "$2" =~ "L" ]]; then # Layout + mrs-run-sub-suite $1 all dynamic_symmetric repro alt + fi + if [[ "$2" =~ "D" ]]; then # Debug + mrs-run-sub-suite $1 ocean_only dynamic_symmetric debug def + fi + if [[ "$2" =~ "T" ]]; then # sTatic + mrs-run-sub-suite $1 static_ocean_only static repro def + fi + popd > /dev/null + if [[ "$2" =~ "R" ]]; then # Restarts + pushd $JOB_DIR/$STATS_REPO_DIR/$WORK_DIR-rst > /dev/null + mrs-run-restarts-sub-suite $1 ocean_only dynamic_symmetric repro def + mrs-run-restarts-sub-suite $1 ice_ocean_SIS2 dynamic_symmetric repro def + popd > /dev/null + fi + + # Indicate all went well + touch $JOB_DIR/CI-BATCH-SUCCESS-$1-$2 + + section-end run-suite-$1-$2 +} + +# Test the value of stats files. All files in results/ are checked for in regressions/. It is assumed +# missing files are intended and failed runs were caught earlier in the CI process. +# Args: +# $1 is path of results to test (relative to $STATS_REPO_DIR) +# $2 is path of correct results to test against (relative to $STATS_REPO_DIR) +compare-stats () { + if [ "$#" -ne 2 ]; then echo "compare-stats needs 2 arguments" ; exit 911 ; fi + section-start-open compare-stats-$1-$2-$3-$4-$5 "Checking stats for '$1' against '$2'" + # This checks that any file in the results directory is exactly the same as in regressions/ + ( cd $JOB_DIR/$STATS_REPO_DIR/$1 ; md5sum `find * -type f` ) | ( cd $JOB_DIR/$STATS_REPO_DIR/$2 ; md5sum -c ) 2>&1 | sed "s/ OK/$GRN&$OFF/;s/ FAILED/$RED&$OFF/;s/WARNING/$RED&$OFF/" + FAIL=${PIPESTATUS[1]} + if [ ! $FAIL == 0 ]; then + exit 911 + fi + section-end compare-stats-$1-$2-$3-$4-$5 +} + +# Test the value of stats files for a class of run +# $1 - compiler brand +# $2 - any combination of "SNLDTR" +# S = symmetric +# N = non-symmetric +# L = layout +# D = debug +# T = static +# R = restarts +# +# Many tests are tested against the "dynamic_symmetric repro" suite which must also have been run. +# The "dynamic_symmetric repro" tests alone are checked against the regressions. This is so that +# the pipelines might separate errors that are internally inconsistent. +check-stats () { + if [ "$#" -ne 2 ]; then echo "check-stats needs 2 arguments" ; exit 911 ; fi + + if [[ "$2" =~ "S" ]]; then # Symmetric + compare-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats regressions + fi + if [[ "$2" =~ "N" ]]; then # Non-symmetric + compare-stats $CONFIGS_DIR/results/$1-all-dynamic_nonsymmetric-repro-def-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "L" ]]; then # Layout + compare-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-alt-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "D" ]]; then # Debug + compare-stats $CONFIGS_DIR/results/$1-ocean_only-dynamic_symmetric-debug-def-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "T" ]]; then # sTatic + compare-stats $CONFIGS_DIR/results/$1-static_ocean_only-static-repro-def-stats $CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-stats + fi + if [[ "$2" =~ "R" ]]; then # Restarts + pushd $JOB_DIR/$STATS_REPO_DIR/tmp-$CONFIGS_DIR-$1-rst > /dev/null + make -f tools/MRS/Makefile.restart restart_$1_ocean_only restart_$1_ice_ocean_SIS2 -s -k + popd > /dev/null + fi + +} + +# Helper function to compare two files +# Args: +# $1 is source directory +# $2 is target directory +# $3- are file names that should exist relative to both $1 and $2 +# +# Operations for `compare-files src/ tgt/ file1 file2 file3`: +# 1. create the md5sum of file1, file2, and file3, in src/ and then run `md5sum-c` in tgt/ +# 2. if differences are detected, +# a. report the "OK" results first, then the "FAILED". +# b. report the "FAILED". +# c. for each failed file, show the `diff src/$f tgt/$f` +# 3. if no differences are detected, show `md5sum -c` output so the log lists all files that were checked +compare-files () { + SRC=$1 + TGT=$2 + shift; shift + FILES=$@ + ( cd $SRC ; md5sum $FILES ) | ( cd $TGT ; md5sum -c ) | sed -r "s/([A-Za-z0-9_\.\/\-]*): ([A-Z]*)/\2 \1/;s/OK /${GRN}PASS$OFF /;s/FAILED /${RED}FAILED$OFF /" + FAIL=${PIPESTATUS[1]} + if [ ! $FAIL == 0 ]; then + echo Differences follow: + # All is not well so re-order md5sum to summarize status + DFILES=$( ( cd $SRC ; md5sum $FILES ) | ( cd $TGT ; md5sum -c 2> /dev/null ) | grep ": FAILED" | sed 's/:.*//') + for f in $DFILES; do + echo diff $SRC/$f $TGT/$f | sed "s:$JOB_DIR/$STATS_REPO_DIR/::g;s:$CONFIGS_DIR/results/::" + diff $SRC/$f $TGT/$f || true + done + echo Files $DFILES had differences + exit 911 + fi +} + +# Test the value of param files. All files generated in results/ are looked for $CONFIGS_DIR +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +check-params () { + if [ "$#" -ne 1 ]; then echo "check-params needs 1 argument" ; exit 911 ; fi + section-start-open check-params-$1 "Checking params for $1" + SRC=$JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-params + FILES=$( cd $SRC ; find * -name "*parameter_doc*" -type f ) + compare-files $SRC $JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR $FILES + section-end check-params-$1 +} + +# Test the value of available_diag files. Only those recorded in $CONFIGS_DIR are checked. +# Args: +# $1 is compiler (gnu, intel, pgi, ...) +check-diags () { + if [ "$#" -ne 1 ]; then echo "check-diags needs 1 argument" ; exit 911 ; fi + section-start-open check-diags-$1 "Checking diagnostics for $1" + # This checks that any file in the results directory is exactly the same as in regressions/ + SRC=$JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR/results/$1-all-dynamic_symmetric-repro-def-params + TGT=$JOB_DIR/$STATS_REPO_DIR/$CONFIGS_DIR + EXP_GROUPS=`grep / $TGT/manifest.mk | sed 's:/.*::' | uniq` + #FILES=$( cd $TGT ; find $EXP_GROUPS -name "*available_diags*" -type f ) + # The following option finds the intersection between all available_diags in both $TGT and $SRC because + # $SRC contains more than are recorded in $TGT but $TGT might have some that we no longer monitor + FILES=$( comm -12 <(cd $SRC; find $EXP_GROUPS -name '*available_diags*' -type f | sort) <(cd $TGT; find $EXP_GROUPS -name '*available_diags*' -type f | sort) ) + compare-files $SRC $TGT $FILES + section-end check-diags-$1 +} + +# Process command line +START_DIR=`pwd` +while [[ $# -gt 0 ]]; do # Loop through arguments + cd $START_DIR + arg=$1 + shift + case "$arg" in + -n | --norun) + DRYRUN=1; echo Dry-run enabled; continue ;; + +n | ++norun) + DRYRUN=; echo Dry-run disabled; continue ;; + -x) + set -x; continue ;; + +x) + set +x; continue ;; + clean-job-dir) + clean-job-dir; continue ;; + create-job-dir) + create-job-dir https://gitlab.gfdl.noaa.gov/ogrp/Gaea-stats-MOM6-examples.git dev/gfdl; continue ;; + copy-test-space) + copy-test-space $1; shift; continue ;; + mrs-compile) + mrs-compile $1; shift; continue ;; + nolibs-ocean-only-compile) + nolibs-ocean-only-compile $1; shift; continue ;; + nolibs-ocean-ice-compile) + nolibs-ocean-ice-compile $1; shift; continue ;; + run-suite) + run-suite $1 $2; shift; shift; continue ;; + check-stats) + check-stats $1 $2; shift; shift; continue ;; + check-params) + check-params $1; shift; continue ;; + check-diags) + check-diags $1; shift; continue ;; + *) + echo \"$arg\" is not a recognized argument! ; exit 9 ;; + esac +done diff --git a/.testing/Makefile b/.testing/Makefile index 530a552181..8a79d86e0a 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -11,7 +11,7 @@ # Delete the MOM6 test executables and dependency builds (FMS) # # make clean.build -# Delete only the MOM6 test executables +# Delete only the MOM6 test executables # # # Configuration: @@ -57,6 +57,9 @@ # MOM_TARGET_LOCAL_BRANCH Target branch name # (NOTE: These would typically be configured by a CI.) # +# Paths for stages: +# WORKSPACE Location to place work/ and results/ directories (i.e. where to run the model) +# #---- # TODO: POSIX shell compatibility @@ -129,6 +132,8 @@ CONFIGS ?= $(wildcard tc*) TESTS ?= grid layout rotate restart openmp nan $(foreach d,$(DIMS),dim.$(d)) DIMS ?= t l h z q r +# Default is to place work/ and results/ in current directory +WORKSPACE ?= . #--- # Test configuration @@ -204,34 +209,11 @@ endif FMS_SOURCE = $(call SOURCE,deps/fms/src) -#--- -# Python preprocessing environment configuration - -HAS_NUMPY = $(shell python -c "import numpy" 2> /dev/null && echo "yes") -HAS_NETCDF4 = $(shell python -c "import netCDF4" 2> /dev/null && echo "yes") - -USE_VENV = -ifneq ($(HAS_NUMPY), yes) - USE_VENV = yes -endif -ifneq ($(HAS_NETCDF4), yes) - USE_VENV = yes -endif - -# When disabled, activation is a null operation (`true`) -VENV_PATH = -VENV_ACTIVATE = true -ifeq ($(USE_VENV), yes) - VENV_PATH = work/local-env - VENV_ACTIVATE = . $(VENV_PATH)/bin/activate -endif - - #--- # Rules .PHONY: all build.regressions build.prof -all: $(foreach b,$(BUILDS),build/$(b)) $(VENV_PATH) +all: $(foreach b,$(BUILDS),build/$(b)) build.regressions: $(foreach b,symmetric target,build/$(b)/MOM6) build.prof: $(foreach b,opt opt_target,build/$(b)/MOM6) @@ -382,8 +364,8 @@ deps/Makefile: ../ac/deps/Makefile # broken the ability to compile. This is not a means to build a complete # coupled executable. # TODO: -# - Avoid re-building FMS and MOM6 src by re-using existing object/mod files -# - Use autoconf rather than mkmf templates +# - Avoid re-building FMS and MOM6 src by re-using existing object/mod files +# - Use autoconf rather than mkmf templates MK_TEMPLATE ?= ../../deps/mkmf/templates/ncrc-gnu.mk # NUOPC driver @@ -402,21 +384,6 @@ build/mct/mom_ocean_model_mct.o: build/mct/Makefile check_mom6_api_mct: build/mct/mom_ocean_model_mct.o -#--- -# Python preprocessing - -# NOTE: Some less mature environments (e.g. Arm64 Ubuntu) require explicit -# installation of numpy before netCDF4, as well as wheel and cython support. -work/local-env: - python3 -m venv $@ - . $@/bin/activate \ - && python3 -m pip install --upgrade pip \ - && pip3 install wheel \ - && pip3 install cython \ - && pip3 install numpy \ - && pip3 install netCDF4 - - #--- # Testing @@ -446,11 +413,11 @@ endef $(foreach d,$(DIMS),$(eval $(call TEST_DIM_RULE,$(d)))) .PHONY: run.symmetric run.asymmetric run.nans run.openmp run.cov -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.nan: $(foreach c,$(CONFIGS),work/$(c)/nan/ocean.stats) -run.openmp: $(foreach c,$(CONFIGS),work/$(c)/openmp/ocean.stats) -run.cov: $(foreach c,$(CONFIGS),work/$(c)/cov/ocean.stats) +run.symmetric: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/symmetric/ocean.stats) +run.asymmetric: $(foreach c,$(filter-out tc3,$(CONFIGS)),$(CONFIGS),$(WORKSPACE)/work/$(c)/asymmetric/ocean.stats) +run.nan: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/nan/ocean.stats) +run.openmp: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/openmp/ocean.stats) +run.cov: $(foreach c,$(CONFIGS),$(WORKSPACE)/work/$(c)/cov/ocean.stats) # Configuration test rules # $(1): Configuration name (tc1, tc2, &c.) @@ -482,21 +449,21 @@ FAIL = ${RED}FAIL${RESET} # $(2): Test type (grid, layout, &c.) # $(3): Comparison targets (symmetric asymmetric, symmetric layout, &c.) define CMP_RULE -.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) +.PRECIOUS: $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/ocean.stats) +$(1).$(2): $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/ocean.stats) + @test "$$(shell ls -A $(WORKSPACE)/results/$(1) 2>/dev/null)" || rm -rf $(WORKSPACE)/results/$(1) @cmp $$^ || !( \ - mkdir -p results/$(1); \ - (diff $$^ | tee results/$(1)/ocean.stats.$(2).diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$(1); \ + (diff $$^ | tee $(WORKSPACE)/results/$(1)/ocean.stats.$(2).diff | head -n 20) ; \ echo -e "$(FAIL): Solutions $(1).$(2) have changed." \ ) @echo -e "$(PASS): Solutions $(1).$(2) agree." -.PRECIOUS: $(foreach b,$(3),work/$(1)/$(b)/chksum_diag) -$(1).$(2).diag: $(foreach b,$(3),work/$(1)/$(b)/chksum_diag) +.PRECIOUS: $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/chksum_diag) +$(1).$(2).diag: $(foreach b,$(3),$(WORKSPACE)/work/$(1)/$(b)/chksum_diag) @cmp $$^ || !( \ - mkdir -p results/$(1); \ - (diff $$^ | tee results/$(1)/chksum_diag.$(2).diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$(1); \ + (diff $$^ | tee $(WORKSPACE)/results/$(1)/chksum_diag.$(2).diff | head -n 20) ; \ echo -e "$(FAIL): Diagnostics $(1).$(2).diag have changed." \ ) @echo -e "$(PASS): Diagnostics $(1).$(2).diag agree." @@ -516,14 +483,15 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # Custom comparison rules + # Restart tests only compare the final stat record -.PRECIOUS: $(foreach b,symmetric restart target,work/%/$(b)/ocean.stats) -%.restart: $(foreach b,symmetric restart,work/%/$(b)/ocean.stats) - @test "$(shell ls -A results/$* 2>/dev/null)" || rm -rf results/$* +.PRECIOUS: $(foreach b,symmetric restart target,$(WORKSPACE)/work/%/$(b)/ocean.stats) +%.restart: $(foreach b,symmetric restart,$(WORKSPACE)/work/%/$(b)/ocean.stats) + @test "$(shell ls -A $(WORKSPACE)/results/$* 2>/dev/null)" || rm -rf $(WORKSPACE)/results/$* @cmp $(foreach f,$^,<(tr -s ' ' < $(f) | cut -d ' ' -f3- | tail -n 1)) \ || !( \ - mkdir -p results/$*; \ - (diff $^ | tee results/$*/chksum_diag.restart.diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$*; \ + (diff $^ | tee $(WORKSPACE)/results/$*/chksum_diag.restart.diff | head -n 20) ; \ echo -e "$(FAIL): Solutions $*.restart have changed." \ ) @echo -e "$(PASS): Solutions $*.restart agree." @@ -531,21 +499,21 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # TODO: chksum_diag parsing of restart files # stats rule is unchanged, but we cannot use CMP_RULE to generate it. -%.regression: $(foreach b,symmetric target,work/%/$(b)/ocean.stats) - @test "$(shell ls -A results/$* 2>/dev/null)" || rm -rf results/$* +%.regression: $(foreach b,symmetric target,$(WORKSPACE)/work/%/$(b)/ocean.stats) + @test "$(shell ls -A $(WORKSPACE)/results/$* 2>/dev/null)" || rm -rf $(WORKSPACE)/results/$* @cmp $^ || !( \ - mkdir -p results/$*; \ - (diff $^ | tee results/$*/ocean.stats.regression.diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$*; \ + (diff $^ | tee $(WORKSPACE)/results/$*/ocean.stats.regression.diff | head -n 20) ; \ echo -e "$(FAIL): Solutions $*.regression have changed." \ ) @echo -e "$(PASS): Solutions $*.regression agree." # Regression testing only checks for changes in existing diagnostics -%.regression.diag: $(foreach b,symmetric target,work/%/$(b)/chksum_diag) +%.regression.diag: $(foreach b,symmetric target,$(WORKSPACE)/work/%/$(b)/chksum_diag) @! diff $^ | grep "^[<>]" | grep "^>" > /dev/null \ || ! (\ - mkdir -p results/$*; \ - (diff $^ | tee results/$*/chksum_diag.regression.diff | head -n 20) ; \ + mkdir -p $(WORKSPACE)/results/$*; \ + (diff $^ | tee $(WORKSPACE)/results/$*/chksum_diag.regression.diff | head -n 20) ; \ echo -e "$(FAIL): Diagnostics $*.regression.diag have changed." \ ) @cmp $^ || ( \ @@ -555,10 +523,26 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) @echo -e "$(PASS): Diagnostics $*.regression.diag agree." +#--- +# Preprocessing +# NOTE: This only support tc4, but can be generalized over all tests. +.PHONY: preproc +preproc: tc4/Makefile + cd tc4 && $(MAKE) LAUNCHER="$(MPIRUN)" +preproc-compile: tc4/Makefile + cd tc4 && $(MAKE) executables + +tc4/Makefile: tc4/configure tc4/Makefile.in + cd $(@D) && ./configure || (cat config.log && false) + +tc4/configure: tc4/configure.ac + cd $(@D) && autoreconf -if + + #--- # Test run output files -# Rule to build work//{ocean.stats,chksum_diag}. +# Rule to build $(WORKSPACE)/work//{ocean.stats,chksum_diag}. # $(1): Test configuration name # $(2): Executable type # $(3): Enable coverage flag @@ -567,22 +551,15 @@ $(foreach c,$(CONFIGS),$(eval $(call CONFIG_DIM_RULE,$(c)))) # $(6): Number of MPI ranks define STAT_RULE -work/%/$(1)/ocean.stats work/%/$(1)/chksum_diag: build/$(2)/MOM6 $(VENV_PATH) +$(WORKSPACE)/work/%/$(1)/ocean.stats $(WORKSPACE)/work/%/$(1)/chksum_diag: build/$(2)/MOM6 | preproc @echo "Running test $$*.$(1)..." mkdir -p $$(@D) cp -RL $$*/* $$(@D) - if [ -f $$(@D)/Makefile ]; then \ - $$(VENV_ACTIVATE) \ - && cd $$(@D) \ - && $(MAKE); \ - else \ - cd $$(@D); \ - fi mkdir -p $$(@D)/RESTART echo -e "$(4)" > $$(@D)/MOM_override - rm -f results/$$*/std.$(1).{out,err} + rm -f $(WORKSPACE)/results/$$*/std.$(1).{out,err} cd $$(@D) \ - && $(TIME) $(5) $(MPIRUN) -n $(6) ../../../$$< 2> std.err > std.out \ + && $(TIME) $(5) $(MPIRUN) -n $(6) $(abspath $$<) 2> std.err > std.out \ || !( \ mkdir -p ../../../results/$$*/ ; \ cat std.out | tee ../../../results/$$*/std.$(1).out | tail -n 20 ; \ @@ -592,7 +569,7 @@ 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/$$* ; \ + mkdir -p $(WORKSPACE)/results/$$* ; \ cd build/$(2) ; \ gcov -b *.gcda > gcov.$$*.$(1).out ; \ find -name "*.gcov" -exec sed -i -r 's/^( *[0-9]*)\*:/ \1:/g' {} \; ; \ @@ -615,7 +592,7 @@ report.cov: run.cov codecov || { \ cat build/cov/codecov.err ; \ echo -e "${RED}Failed to upload report.${RESET}" ; \ - if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ + if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } # Define $(,) as comma escape character @@ -643,17 +620,10 @@ $(eval $(call STAT_RULE,cov,cov,true,,,1)) # 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) +$(WORKSPACE)/work/%/restart/ocean.stats: build/symmetric/MOM6 | preproc rm -rf $(@D) mkdir -p $(@D) cp -RL $*/* $(@D) - if [ -f $(@D)/Makefile ]; then \ - $(VENV_ACTIVATE) \ - && cd work/$*/restart \ - && $(MAKE); \ - else \ - cd work/$*/restart; \ - fi mkdir -p $(@D)/RESTART # Set the half-period cd $(@D) \ @@ -664,9 +634,9 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) && 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} + rm -f $(WORKSPACE)/results/$*/std.restart{1,2}.{out,err} # Run the first half-period - cd $(@D) && $(TIME) $(MPIRUN) -n 1 ../../../$< 2> std1.err > std1.out \ + cd $(@D) && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std1.err > std1.out \ || !( \ cat std1.out | tee ../../../results/$*/std.restart1.out | tail -n 20 ; \ cat std1.err | tee ../../../results/$*/std.restart1.err | tail -n 20 ; \ @@ -677,7 +647,7 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) mkdir $(@D)/RESTART cd $(@D) && sed -i -e "s/input_filename *= *'n'/input_filename = 'r'/g" input.nml # Run the second half-period - cd $(@D) && $(TIME) $(MPIRUN) -n 1 ../../../$< 2> std2.err > std2.out \ + cd $(@D) && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std2.err > std2.out \ || !( \ cat std2.out | tee ../../../results/$*/std.restart2.out | tail -n 20 ; \ cat std2.err | tee ../../../results/$*/std.restart2.err | tail -n 20 ; \ @@ -690,20 +660,20 @@ work/%/restart/ocean.stats: build/symmetric/MOM6 $(VENV_PATH) # Not a true rule; only call this after `make test` to summarize test results. .PHONY: test.summary test.summary: - @if ls results/*/* &> /dev/null; then \ - if ls results/*/std.*.err &> /dev/null; then \ + @if ls $(WORKSPACE)/results/*/* &> /dev/null; then \ + if ls $(WORKSPACE)/results/*/std.*.err &> /dev/null; then \ echo "The following tests failed to complete:" ; \ - ls results/*/std.*.out \ + ls $(WORKSPACE)/results/*/std.*.out \ | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[2]; if(length(t)>3) v=v"."t[3]; print a[2],":",v}'; \ fi; \ - if ls results/*/ocean.stats.*.diff &> /dev/null; then \ + if ls $(WORKSPACE)/results/*/ocean.stats.*.diff &> /dev/null; then \ echo "The following tests report solution regressions:" ; \ - ls results/*/ocean.stats.*.diff \ + ls $(WORKSPACE)/results/*/ocean.stats.*.diff \ | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[3]; if(length(t)>4) v=v"."t[4]; print a[2],":",v}'; \ fi; \ - if ls results/*/chksum_diag.*.diff &> /dev/null; then \ + if ls $(WORKSPACE)/results/*/chksum_diag.*.diff &> /dev/null; then \ echo "The following tests report diagnostic regressions:" ; \ - ls results/*/chksum_diag.*.diff \ + ls $(WORKSPACE)/results/*/chksum_diag.*.diff \ | awk '{split($$0,a,"/"); split(a[3],t,"."); v=t[2]; if(length(t)>3) v=v"."t[3]; print a[2],":",v}'; \ fi; \ false ; \ @@ -719,28 +689,28 @@ test.summary: .PHONY: run.cov.unit run.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov -work/unit/std.out: build/unit/MOM_unit_tests +$(WORKSPACE)/work/unit/std.out: build/unit/MOM_unit_tests if [ $(REPORT_COVERAGE) ]; then \ find build/unit -name *.gcda -exec rm -f '{}' \; ; \ fi rm -rf $(@D) mkdir -p $(@D) cd $(@D) \ - && $(TIME) $(MPIRUN) -n 1 ../../$< 2> std.err > std.out \ + && $(TIME) $(MPIRUN) -n 1 $(abspath $<) 2> std.err > std.out \ || !( \ cat std.out | tail -n 100 ; \ cat std.err | tail -n 100 ; \ ) cd $(@D) \ - && $(TIME) $(MPIRUN) -n 2 ../../$< 2> p2.std.err > p2.std.out \ + && $(TIME) $(MPIRUN) -n 2 $(abspath $<) 2> p2.std.err > p2.std.out \ || !( \ cat p2.std.out | tail -n 100 ; \ cat p2.std.err | tail -n 100 ; \ ) # NOTE: .gcov actually depends on .gcda, but .gcda is produced with std.out -# TODO: Replace work/unit/std.out with *.gcda? -build/unit/MOM_file_parser_tests.F90.gcov: work/unit/std.out +# TODO: Replace $(WORKSPACE)/work/unit/std.out with *.gcda? +build/unit/MOM_file_parser_tests.F90.gcov: $(WORKSPACE)/work/unit/std.out cd $(@D) \ && gcov -b *.gcda > gcov.unit.out find $(@D) -name "*.gcov" -exec sed -i -r 's/^( *[0-9]*)\*:/ \1:/g' {} \; @@ -754,7 +724,7 @@ report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov || { \ cat build/unit/codecov.err ; \ echo -e "${RED}Failed to upload report.${RESET}" ; \ - if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ + if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } @@ -767,22 +737,22 @@ PCONFIGS = p0 profile: $(foreach p,$(PCONFIGS), prof.$(p)) .PHONY: prof.p0 -prof.p0: work/p0/opt/clocks.json work/p0/opt_target/clocks.json +prof.p0: $(WORKSPACE)/work/p0/opt/clocks.json $(WORKSPACE)/work/p0/opt_target/clocks.json python tools/compare_clocks.py $^ -work/p0/%/clocks.json: work/p0/%/std.out +$(WORKSPACE)/work/p0/%/clocks.json: $(WORKSPACE)/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 +$(WORKSPACE)/work/p0/opt/std.out: build/opt/MOM6 +$(WORKSPACE)/work/p0/opt_target/std.out: build/opt_target/MOM6 -work/p0/%/std.out: +$(WORKSPACE)/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 + && $(MPIRUN) -n 1 $(abspath $<) 2> std.err > std.out #--- @@ -795,16 +765,16 @@ PERF_EVENTS ?= perf: $(foreach p,$(PCONFIGS), perf.$(p)) .PHONY: prof.p0 -perf.p0: work/p0/opt/profile.json work/p0/opt_target/profile.json +perf.p0: $(WORKSPACE)/work/p0/opt/profile.json $(WORKSPACE)/work/p0/opt_target/profile.json python tools/compare_perf.py $^ -work/p0/%/profile.json: work/p0/%/perf.data +$(WORKSPACE)/work/p0/%/profile.json: $(WORKSPACE)/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 +$(WORKSPACE)/work/p0/opt/perf.data: build/opt/MOM6 +$(WORKSPACE)/work/p0/opt_target/perf.data: build/opt_target/MOM6 -work/p0/%/perf.data: +$(WORKSPACE)/work/p0/%/perf.data: mkdir -p $(@D) cp -RL p0/* $(@D) mkdir -p $(@D)/RESTART @@ -835,4 +805,11 @@ clean.build: .PHONY: clean.stats clean.stats: @[ $$(basename $$(pwd)) = .testing ] - rm -rf work results + rm -rf $(WORKSPACE)/work $(WORKSPACE)/results + + +.PHONY: clean.preproc +clean.preproc: + @if [ -f tc4/Makefile ] ; then \ + cd tc4 && make clean ; \ + fi diff --git a/.testing/tc4/.gitignore b/.testing/tc4/.gitignore index 29f62fb208..4f9cc2826f 100644 --- a/.testing/tc4/.gitignore +++ b/.testing/tc4/.gitignore @@ -1,4 +1,15 @@ +# Autoconf +aclocal.m4 +autom4te.cache/ +config.log +config.status +configure~ + +# Output +gen_grid ocean_hgrid.nc +topog.nc + +gen_data sponge.nc temp_salt_ic.nc -topog.nc diff --git a/.testing/tc4/MOM_input b/.testing/tc4/MOM_input index e33bf40bf6..591ed4c788 100644 --- a/.testing/tc4/MOM_input +++ b/.testing/tc4/MOM_input @@ -1,25 +1,25 @@ ! This file was written by the model and records the non-default parameters used at run-time. ! === module MOM === - -! === module MOM_unit_scaling === -! Parameters for doing unit scaling of variables. USE_REGRIDDING = True ! [Boolean] default = False ! If True, use the ALE algorithm (regridding/remapping). If False, use the ! layered isopycnal algorithm. -DT = 1200.0 ! [s] +DT = 1200.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 = 300.0 +DT_THERM = 3600.0 ! [s] default = 1200.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. + ! multiple of the coupling timestep. By default DT_THERM is set to DT. 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. +USE_PSURF_IN_EOS = False ! [Boolean] default = True + ! If true, always include the surface pressure contributions in equation of + ! state calculations. SAVE_INITIAL_CONDS = False ! [Boolean] default = False ! If true, write the initial conditions to a file given by IC_OUTPUT_FILE. @@ -33,9 +33,6 @@ NJGLOBAL = 10 ! ! The total number of thickness grid points in the y-direction in the physical ! domain. With STATIC_MEMORY_ this is set in MOM_memory.h at compile time. -! === module MOM_hor_index === -! Sets the horizontal array index types. - ! === module MOM_verticalGrid === ! Parameters providing information about the vertical grid. NK = 2 ! [nondim] @@ -65,8 +62,9 @@ TOPO_CONFIG = "file" ! ! 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. - ! Neverland - use the Neverland 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 @@ -83,9 +81,6 @@ TOPO_CONFIG = "file" ! !MAXIMUM_DEPTH = 100.0 ! [m] ! The (diagnosed) maximum depth of the ocean. -! === module MOM_open_boundary === -! Controls where open boundaries are located, what kind of boundary condition to impose, and what data to apply, -! if any. ROTATION = "betaplane" ! default = "2omegasinlat" ! This specifies how the Coriolis parameter is specified: ! 2omegasinlat - Use twice the planetary rotation rate @@ -94,6 +89,10 @@ ROTATION = "betaplane" ! default = "2omegasinlat" ! USER - call a user modified routine. F_0 = 1.0E-04 ! [s-1] default = 0.0 ! The reference value of the Coriolis parameter with the betaplane option. +GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = False + ! If true, use an older algorithm to calculate the sine and cosines needed + ! rotate between grid-oriented directions and true north and east. Differences + ! arise at the tripolar fold. ! === module MOM_tracer_registry === @@ -106,12 +105,10 @@ DRHO_DS = 0.0 ! [kg m-3 PSU-1] default = 0.8 ! When EQN_OF_STATE=LINEAR, this is the partial derivative of density with ! salinity. -! === module MOM_restart === - ! === module MOM_tracer_flow_control === ! === module MOM_coord_initialization === -COORD_CONFIG = "linear" ! +COORD_CONFIG = "linear" ! 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 @@ -129,6 +126,10 @@ COORD_CONFIG = "linear" ! ! ts_profile - use temperature and salinity profiles ! (read from COORD_FILE) to set layer densities. ! USER - call a user modified routine. +REMAP_UV_USING_OLD_ALG = True ! [Boolean] default = False + ! If true, uses the old remapping-via-a-delta-z method for remapping u and v. If + ! false, uses the new method that remaps between grids described by an old and + ! new thickness. REGRIDDING_COORDINATE_MODE = "Z*" ! default = "LAYER" ! Coordinate mode for vertical regridding. Choose among the following ! possibilities: LAYER - Isopycnal or stacked shallow water layers @@ -137,6 +138,7 @@ REGRIDDING_COORDINATE_MODE = "Z*" ! default = "LAYER" ! SIGMA - terrain following coordinates ! RHO - continuous isopycnal ! HYCOM1 - HyCOM-like hybrid coordinate + ! HYBGEN - Hybrid coordinate from the Hycom hybgen code ! SLIGHT - stretched coordinates above continuous isopycnal ! ADAPTIVE - optimize for smooth neutral density surfaces !ALE_RESOLUTION = 2*50.0 ! [m] @@ -150,14 +152,14 @@ REMAPPING_SCHEME = "PPM_IH4" ! default = "PLM" ! variables. It can be one of the following schemes: PCM (1st-order ! accurate) ! PLM (2nd-order accurate) + ! PLM_HYBGEN (2nd-order accurate) ! PPM_H4 (3rd-order accurate) ! PPM_IH4 (3rd-order accurate) + ! PPM_HYBGEN (3rd-order accurate) + ! WENO_HYBGEN (3rd-order accurate) ! PQM_IH4IH3 (4th-order accurate) ! PQM_IH6IH5 (5th-order accurate) -! === module MOM_grid === -! Parameters providing information about the lateral grid. - ! === module MOM_state_initialization === INIT_LAYERS_FROM_Z_FILE = True ! [Boolean] default = False ! If true, initialize the layer thicknesses, temperatures, and salinities from a @@ -181,9 +183,9 @@ SPONGE_PTEMP_VAR = "ptemp" ! default = "PTEMP" ! The name of the potential temperature variable in SPONGE_STATE_FILE. SPONGE_SALT_VAR = "salt" ! default = "SALT" ! The name of the salinity variable in SPONGE_STATE_FILE. -NEW_SPONGES = True ! [of sponge restoring data.] default = False - ! Set True if using the newer sponging code which performs on-the-fly regridding - ! in lat-lon-time. +INTERPOLATE_SPONGE_TIME_SPACE = True ! [Boolean] default = False + ! If True, perform on-the-fly regridding in lat-lon-time of sponge restoring + ! data. ! === module MOM_sponge === SPONGE_DATA_ONGRID = True ! [Boolean] default = False @@ -192,8 +194,9 @@ SPONGE_DATA_ONGRID = True ! [Boolean] default = False ! The total number of columns where sponges are applied at h points. ! === module MOM_diag_mediator === - -! === module MOM_MEKE === +DIAG_AS_CHKSUM = True ! [Boolean] default = False + ! Instead of writing diagnostics to the diag manager, write a text file + ! containing the checksum (bitcount) of the array. ! === module MOM_lateral_mixing_coeffs === @@ -202,10 +205,10 @@ LINEAR_DRAG = True ! [Boolean] default = False ! If LINEAR_DRAG and BOTTOMDRAGLAW are defined the drag law is ! cdrag*DRAG_BG_VEL*u. 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. + ! The thickness of a bottom boundary layer with a viscosity increased by + ! KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which + ! near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is + ! defined but LINEAR_DRAG is not. CDRAG = 0.002 ! [nondim] default = 0.003 ! CDRAG is the drag coefficient relating the magnitude of the velocity field to ! the bottom stress. CDRAG is only used if BOTTOMDRAGLAW is defined. @@ -214,7 +217,7 @@ DRAG_BG_VEL = 0.05 ! [m s-1] default = 0.0 ! 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_USE_EOS = True ! [Boolean] default = False +BBL_USE_EOS = True ! [Boolean] default = True ! If true, use the equation of state in determining the properties of the bottom ! boundary layer. Otherwise use the layer target potential densities. BBL_THICK_MIN = 0.1 ! [m] default = 0.0 @@ -228,6 +231,13 @@ KV = 1.0E-04 ! [m2 s-1] ! === module MOM_thickness_diffuse === KHTH = 500.0 ! [m2 s-1] default = 0.0 ! The background horizontal thickness diffusivity. +USE_GM_WORK_BUG = True ! [Boolean] default = False + ! If true, compute the top-layer work tendency on the u-grid with the incorrect + ! sign, for legacy reproducibility. + +! === module MOM_porous_barriers === + +! === module MOM_dynamics_split_RK2 === BE = 0.7 ! [nondim] default = 0.6 ! If SPLIT is true, BE determines the relative weighting of a 2nd-order ! Runga-Kutta baroclinic time stepping scheme (0.5) and a backward Euler scheme @@ -258,7 +268,7 @@ BOUND_CORIOLIS = True ! [Boolean] default = False ! === module MOM_PressureForce === -! === module MOM_PressureForce_AFV === +! === module MOM_PressureForce_FV === RECONSTRUCT_FOR_PRESSURE = False ! [Boolean] default = True ! If True, use vertical reconstruction of T & S within the integrals of the FV ! pressure gradient calculation. If False, use the constant-by-layer algorithm. @@ -269,17 +279,25 @@ SMAGORINSKY_AH = True ! [Boolean] default = False ! If true, use a biharmonic Smagorinsky nonlinear eddy viscosity. SMAG_BI_CONST = 0.03 ! [nondim] default = 0.0 ! The nondimensional biharmonic Smagorinsky constant, typically 0.015 - 0.06. +USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = True + ! If true, use the land mask for the computation of thicknesses at velocity + ! locations. This eliminates the dependence on arbitrary values over land or + ! outside of the domain. ! === module MOM_vert_friction === DIRECT_STRESS = True ! [Boolean] default = False ! If true, the wind stress is distributed over the topmost HMIX_STRESS of fluid - ! (like in HYCOM), and KVML may be set to a very small value. + ! (like in HYCOM), and an added mixed layer viscosity or a physically based + ! boundary layer turbulence parameterization is not needed for stability. HMIX_FIXED = 20.0 ! [m] ! The prescribed depth over which the near-surface viscosity and diffusivity are ! elevated when the bulk mixed layer is not used. -KVML = 0.01 ! [m2 s-1] default = 1.0E-04 - ! The kinematic viscosity in the mixed layer. A typical value is ~1e-2 m2 s-1. - ! KVML is not used if BULKMIXEDLAYER is true. The default is set by KV. +KV_ML_INVZ2 = 0.01 ! [m2 s-1] default = 0.0 + ! An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, with + ! the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the distance + ! from the surface, to allow for finite wind stresses to be transmitted through + ! infinitesimally thin surface layers. This is an older option for numerical + ! convenience without a strong physical basis, and its use is now discouraged. MAXVEL = 10.0 ! [m s-1] default = 3.0E+08 ! The maximum velocity allowed before the velocity components are truncated. @@ -304,23 +322,11 @@ DTBT = 10.0 ! [s or nondim] default = -0.98 ! 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 === +! === module MOM_diagnostics === ! === module MOM_diabatic_driver === ! The following parameters are used for diabatic processes. -! === module MOM_CVMix_KPP === -! This is the MOM wrapper to CVMix:KPP -! See http://cvmix.github.io/ - -! === module MOM_tidal_mixing === -! Vertical Tidal Mixing Parameterization - -! === module MOM_CVMix_conv === -! Parameterization of enhanced mixing due to convection via CVMix - -! === module MOM_entrain_diffusive === - ! === module MOM_set_diffusivity === BBL_EFFIC = 0.0 ! [nondim] default = 0.2 ! The efficiency with which the energy extracted by bottom drag drives BBL @@ -332,29 +338,18 @@ KD = 0.0 ! [m2 s-1] ! The background diapycnal diffusivity of density in the interior. Zero or the ! molecular value, ~1e-7 m2 s-1, may be used. -! === module MOM_kappa_shear === -! Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008 - -! === module MOM_CVMix_shear === -! Parameterization of shear-driven turbulence via CVMix (various options) - -! === module MOM_CVMix_ddiff === -! Parameterization of mixing due to double diffusion processes via CVMix - ! === module MOM_diabatic_aux === ! The following parameters are used for auxiliary diabatic processes. -! === module MOM_regularize_layers === - ! === module MOM_opacity === +PEN_SW_ABSORB_MINTHICK = 0.001 ! [m] default = 1.0 + ! A thickness that is used to absorb the remaining penetrating shortwave heat + ! flux when it drops below PEN_SW_FLUX_ABSORB. ! === module MOM_tracer_advect === ! === module MOM_tracer_hor_diff === -! === module MOM_neutral_diffusion === -! This module implements neutral diffusion of tracers - ! === 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 @@ -362,6 +357,9 @@ MAXTRUNC = 5000 ! [truncations save_interval-1] default = 0 ! to stop if there is any truncation of velocities. DATE_STAMPED_STDOUT = False ! [Boolean] default = True ! If true, use dates (not times) in messages to stdout +ENERGYSAVEDAYS = 0.125 ! [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 === VARIABLE_WINDS = False ! [Boolean] default = True @@ -375,19 +373,17 @@ BUOY_CONFIG = "zero" ! WIND_CONFIG = "zero" ! ! The character string that indicates how wind forcing is specified. Valid ! options include (file), (2gyre), (1gyre), (gyres), (zero), and (USER). - -! === module MOM_restart === +GUST_CONST = 0.02 ! [Pa] default = 0.0 + ! The background gustiness in the winds. +FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = True + ! If true correct a bug in the time-averaging of the gustless wind friction + ! velocity ! === module MOM_main (MOM_driver) === -DAYMAX = 0.25 ! [days] +DAYMAX = 0.25 ! [days] ! The final time of the whole simulation, in units of TIMEUNIT seconds. This ! also sets the potential end time of the present run segment if the end time is ! not set via ocean_solo_nml in input.nml. - -ENERGYSAVEDAYS = 0.125 ! [days] default = 1.44E+04 - ! The interval in units of TIMEUNIT between saves of the - ! energies of the run and other globally summed diagnostics. - 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 @@ -405,21 +401,13 @@ MAXCPU = 2.88E+04 ! [wall-clock seconds] default = -1.0 ! === module MOM_file_parser === -DIAG_AS_CHKSUM = True DEBUG = True -USE_PSURF_IN_EOS = False ! [Boolean] default = False -GRID_ROTATION_ANGLE_BUGS = True ! [Boolean] default = True INTERPOLATE_RES_FN = True ! [Boolean] default = True GILL_EQUATORIAL_LD = False ! [Boolean] default = False -USE_GM_WORK_BUG = True ! [Boolean] default = True FIX_UNSPLIT_DT_VISC_BUG = False ! [Boolean] default = False -REMAP_UV_USING_OLD_ALG = True ! [Boolean] default = True USE_LAND_MASK_FOR_HVISC = False ! [Boolean] default = False KAPPA_SHEAR_ITER_BUG = True ! [Boolean] default = True KAPPA_SHEAR_ALL_LAYER_TKE_BUG = True ! [Boolean] default = True USE_MLD_ITERATION = False ! [Boolean] default = False -PEN_SW_ABSORB_MINTHICK = 0.001 ! [m] default = 0.001 -GUST_CONST = 0.02 ! [Pa] default = 0.02 -FIX_USTAR_GUSTLESS_BUG = False ! [Boolean] default = False diff --git a/.testing/tc4/Makefile b/.testing/tc4/Makefile deleted file mode 100644 index a9aa395b9c..0000000000 --- a/.testing/tc4/Makefile +++ /dev/null @@ -1,8 +0,0 @@ -OUT=ocean_hgrid.nc sponge.nc temp_salt_ic.nc topog.nc - -$(OUT): - python build_grid.py - python build_data.py - -clean: - rm -rf $(OUT) diff --git a/.testing/tc4/Makefile.in b/.testing/tc4/Makefile.in new file mode 100644 index 0000000000..714a8f19f1 --- /dev/null +++ b/.testing/tc4/Makefile.in @@ -0,0 +1,60 @@ +FC = @FC@ +LD = @LD@ +FCFLAGS = @FCFLAGS@ +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +LAUNCHER ?= + +OUT = ocean_hgrid.nc topog.nc temp_salt_ic.nc sponge.nc + +# Since each program generates two outputs, we can only use one to track the +# creation. The second rule is used to indirectly re-invoke the first rule. +# +# Reference: +# https://www.gnu.org/software/automake/manual/html_node/Multiple-Outputs.html + +# Program output +all: ocean_hgrid.nc temp_salt_ic.nc +executables: gen_data gen_grid + +ocean_hgrid.nc: gen_grid + $(LAUNCHER) ./gen_grid +topog.nc: ocean_hgrid.nc + @test -f $@ || rm -f $^ + @test -f $@ || $(MAKE) $^ + +temp_salt_ic.nc: gen_data ocean_hgrid.nc + $(LAUNCHER) ./gen_data +sponge.nc: temp_salt_ic.nc + @test -f $@ || rm -f $^ + @test -f $@ || $(MAKE) $^ + + +# Programs + +gen_grid: gen_grid.F90 + $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) + +gen_data: gen_data.F90 + $(FC) $(FCFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) + + +# Support + +.PHONY: clean +clean: + rm -rf $(OUT) gen_grid gen_data + +.PHONY: distclean +distclean: clean + rm -f config.log + rm -f config.status + rm -f Makefile + +.PHONY: ac-clean +ac-clean: distclean + rm -f aclocal.m4 + rm -rf autom4te.cache + rm -f configure + rm -f configure~ diff --git a/.testing/tc4/build_data.py b/.testing/tc4/build_data.py deleted file mode 100644 index e060d05cb1..0000000000 --- a/.testing/tc4/build_data.py +++ /dev/null @@ -1,80 +0,0 @@ -import netCDF4 as nc -import numpy as np - -x = nc.Dataset('ocean_hgrid.nc').variables['x'][1::2, 1::2] -y = nc.Dataset('ocean_hgrid.nc').variables['y'][1::2, 1::2] -zbot = nc.Dataset('topog.nc').variables['depth'][:] -zbot0 = zbot.max() - - -def t_fc(x, y, z, radius=5.0, tmag=1.0): - """a radially symmetric anomaly in the center of the domain. - units are meters and degC. - """ - ny, nx = x.shape - nz = z.shape[0] - - x0 = x[int(ny/2), int(nx/2)] - y0 = y[int(ny/2), int(nx/2)] - - tl = np.zeros((nz, ny, nx)) - zb = z[-1] - if len(z) > 1: - zd = z / zb - else: - zd = [0.] - for k in np.arange(len(zd)): - r = np.sqrt((x - x0)**2 + (y - y0)**2) - tl[k, :] += (1.0 - np.minimum(r / radius, 1.0)) * tmag * (1.0 - zd[k]) - return tl - - -ny, nx = x.shape -nz = 3 -z = (np.arange(nz) * zbot0) / nz - -temp = t_fc(x, y, z) -salt = np.zeros(temp.shape)+35.0 -fl = nc.Dataset('temp_salt_ic.nc', 'w', format='NETCDF3_CLASSIC') -fl.createDimension('lon', nx) -fl.createDimension('lat', ny) -fl.createDimension('depth', nz) -fl.createDimension('Time', None) -zv = fl.createVariable('depth', 'f8', ('depth')) -lonv = fl.createVariable('lon', 'f8', ('lon')) -latv = fl.createVariable('lat', 'f8', ('lat')) -timev = fl.createVariable('Time', 'f8', ('Time')) -timev.calendar = 'noleap' -timev.units = 'days since 0001-01-01 00:00:00.0' -timev.modulo = ' ' -tv = fl.createVariable('ptemp', 'f8', ('Time', 'depth', 'lat', 'lon'), - fill_value=-1.e20) -sv = fl.createVariable('salt', 'f8', ('Time', 'depth', 'lat', 'lon'), - fill_value=-1.e20) -tv[:] = temp[np.newaxis, :] -sv[:] = salt[np.newaxis, :] -zv[:] = z -lonv[:] = x[0, :] -latv[:] = y[:, 0] -timev[0] = 0. -fl.sync() -fl.close() - - -# Make Sponge forcing file -dampTime = 20.0 # days -secDays = 8.64e4 -fl = nc.Dataset('sponge.nc', 'w', format='NETCDF3_CLASSIC') -fl.createDimension('lon', nx) -fl.createDimension('lat', ny) -lonv = fl.createVariable('lon', 'f8', ('lon')) -latv = fl.createVariable('lat', 'f8', ('lat')) -spv = fl.createVariable('Idamp', 'f8', ('lat', 'lon'), fill_value=-1.e20) -Idamp = np.zeros((ny, nx)) -if dampTime > 0.: - Idamp = 0.0 + 1.0 / (dampTime * secDays) -spv[:] = Idamp -lonv[:] = x[0, :] -latv[:] = y[:, 0] -fl.sync() -fl.close() diff --git a/.testing/tc4/build_grid.py b/.testing/tc4/build_grid.py deleted file mode 100644 index 7f1be74efd..0000000000 --- a/.testing/tc4/build_grid.py +++ /dev/null @@ -1,76 +0,0 @@ -import netCDF4 as nc -from netCDF4 import stringtochar -import numpy as np - -nx, ny = 14, 10 # Grid size -depth0 = 100. # Uniform depth -ds = 0.01 # grid resolution at the equator in degrees -Re = 6.378e6 # Radius of earth - -topo_ = np.zeros((ny, nx)) + depth0 -f_topo = nc.Dataset('topog.nc', 'w', format='NETCDF3_CLASSIC') -ny, nx = topo_.shape -f_topo.createDimension('ny', ny) -f_topo.createDimension('nx', nx) -f_topo.createDimension('ntiles', 1) -f_topo.createVariable('depth', 'f8', ('ny', 'nx')) -f_topo.createVariable('h2', 'f8', ('ny', 'nx')) -f_topo.variables['depth'][:] = topo_ -f_topo.sync() -f_topo.close() - -x_ = np.arange(0, 2*nx + 1) * ds # units are degrees E -y_ = np.arange(0, 2*ny + 1) * ds # units are degrees N -x, y = np.meshgrid(x_, y_) - -dx = np.zeros((2*ny + 1, 2*nx)) -dy = np.zeros((2*ny, 2*nx + 1)) -rad_deg = np.pi / 180. -dx[:] = (rad_deg * Re * (x[:, 1:] - x[:, 0:-1]) - * np.cos(0.5*rad_deg*(y[:, 0:-1] + y[:, 1:]))) -dy[:] = rad_deg * Re * (y[1:, :] - y[0:-1, :]) - -f_sg = nc.Dataset('ocean_hgrid.nc', 'w', format='NETCDF3_CLASSIC') -f_sg.createDimension('ny', 2*ny) -f_sg.createDimension('nx', 2*nx) -f_sg.createDimension('nyp', 2*ny + 1) -f_sg.createDimension('nxp', 2*nx + 1) -f_sg.createDimension('string', 5) -f_sg.createVariable('y', 'f8', ('nyp', 'nxp')) -f_sg.createVariable('x', 'f8', ('nyp', 'nxp')) -dyv = f_sg.createVariable('dy', 'f8', ('ny', 'nxp')) -dxv = f_sg.createVariable('dx', 'f8', ('nyp', 'nx')) -areav = f_sg.createVariable('area', 'f8', ('ny', 'nx')) -dxv.units = 'm' -dyv.units = 'm' -areav.units = 'm2' -f_sg.createVariable('angle_dx', 'f8', ('nyp', 'nxp')) -f_sg.createVariable('tile', 'S1', ('string')) -f_sg.variables['y'].units = 'degrees' -f_sg.variables['x'].units = 'degrees' -f_sg.variables['dy'].units = 'meters' -f_sg.variables['dx'].units = 'meters' -f_sg.variables['area'].units = 'm2' -f_sg.variables['angle_dx'].units = 'degrees' -f_sg.variables['y'][:] = y -f_sg.variables['x'][:] = x -f_sg.variables['dx'][:] = dx -f_sg.variables['dy'][:] = dy - -# Compute the area bounded by lines of constant -# latitude-longitud on a sphere in m2. -dlon = x_[1:] - x_[:-1] -dlon = np.tile(dlon[np.newaxis, :], (2*ny, 1)) -y1_ = y_[:-1] -y1_ = y1_[:, np.newaxis]*rad_deg -y2_ = y_[1:] -y2_ = y2_[:, np.newaxis]*rad_deg -y1_ = np.tile(y1_, (1, 2*nx)) -y2_ = np.tile(y2_, (1, 2*nx)) -area = rad_deg * Re * Re * (np.sin(y2_) - np.sin(y1_)) * dlon -f_sg.variables['area'][:] = area -f_sg.variables['angle_dx'][:] = 0. -str_ = stringtochar(np.array(['tile1'], dtype='S5')) -f_sg.variables['tile'][:] = str_ -f_sg.sync() -f_sg.close() diff --git a/.testing/tc4/configure.ac b/.testing/tc4/configure.ac new file mode 100644 index 0000000000..c431ad65ef --- /dev/null +++ b/.testing/tc4/configure.ac @@ -0,0 +1,71 @@ +# tc4 preprocessor configuration +AC_PREREQ([2.63]) +AC_INIT([], []) + +# Validate srdcir and configure input +AC_CONFIG_SRCDIR([gen_grid.F90]) +AC_CONFIG_MACRO_DIR([../../ac/m4]) + + +# Explicitly assume free-form Fortran +AC_LANG([Fortran]) +AC_FC_SRCEXT([f90]) + +# We do not need MPI, but we want to emulate the executable used in MOM6 +AX_MPI([], [AC_MSG_ERROR([Could not find MPI launcher.])]) +AC_SUBST([FC], [$MPIFC]) +AC_SUBST([LD], [$MPILD]) + + +# netCDF configuration + +# Search for the Fortran netCDF module. +AX_FC_CHECK_MODULE([netcdf], [], [ + AS_UNSET([ax_fc_cv_mod_netcdf]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([FCFLAGS], ["$FCFLAGS -I$($NF_CONFIG --includedir)"]) + ], [AC_MSG_ERROR([Could not find nf-config.])] + ) + AX_FC_CHECK_MODULE([netcdf], [], [ + AC_MSG_ERROR([Could not find netcdf module.]) + ]) +]) + +# Confirm that the Fortran compiler can link the netCDF C library +AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AS_UNSET([ax_fc_cv_c_lib_netcdf_nc_create]) + AC_PATH_PROG([NC_CONFIG], [nc-config]) + AS_IF([test -n "$NC_CONFIG"], [ + AC_SUBST([LDFLAGS], ["$LDFLAGS -L$($NC_CONFIG --libdir)"]) + ], [ + AC_MSG_ERROR([Could not find nc-config.]) + ]) + AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AC_MSG_ERROR([Could not find netCDF C library.]) + ]) +]) + +# Confirm that the Fortran compiler can link to the netCDF Fortran library. +# NOTE: +# - We test nf_create, rather than nf90_create, since AX_FC_CHECK_LIB can +# not currently probe the Fortran 90 interfaces. +# - nf-config does not have --libdir, so we parse the --flibs output. +AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ + AS_UNSET([ax_fc_cv_lib_netcdff_nf_create]) + AC_PATH_PROG([NF_CONFIG], [nf-config]) + AS_IF([test -n "$NF_CONFIG"], [ + AC_SUBST([LDFLAGS], + ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] + ) + ], [ + AC_MSG_ERROR([Could not find nf-config.]) + ]) + AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ + AC_MSG_ERROR([Could not find netCDF Fortran library.]) + ]) +]) + + +AC_CONFIG_FILES([Makefile]) +AC_OUTPUT diff --git a/.testing/tc4/gen_data.F90 b/.testing/tc4/gen_data.F90 new file mode 100644 index 0000000000..8f44aa1465 --- /dev/null +++ b/.testing/tc4/gen_data.F90 @@ -0,0 +1,189 @@ +use netcdf +implicit none + +integer, parameter :: dp = selected_real_kind(10, 100) + !! Double precision (8-byte) + +integer, parameter :: nz = 3 + !! Number of vertical layers +real(kind=dp), parameter :: salt0 = 35._dp + !! Background salinity +real(kind=dp), parameter :: dampTime = 20._dp + !! Sponge damping timescale [days] +real(kind=dp), parameter :: secs_per_day = 86400._dp + !! Seconds per calendar day + +integer :: ncid + +integer :: x_id, y_id +integer :: lon_dimid, lat_dimid, depth_dimid, time_dimid +integer :: lon_id, lat_id, depth_id, time_id, temp_id, salt_id, idamp_id +integer :: field_dimids(2) +integer :: nx, ny + +integer :: i, rc + +real(kind=dp), allocatable :: x(:,:), y(:,:), z(:) + !! Temperature grid positions +real(kind=dp), allocatable :: zbot(:,:) + !! Bottom topography +real(kind=dp) :: zbot0 + !! Maximum topographic depth +real(kind=dp), allocatable :: temp(:,:,:), salt(:,:,:) + !! Initial temperature and salinity fields +real(kind=dp), allocatable :: Idamp(:,:) + !! Sponge dampening rate + +! Read the domain grid +rc = nf90_open('ocean_hgrid.nc', NF90_NOWRITE, ncid) + +rc = nf90_inq_varid(ncid, 'x', x_id) +rc = nf90_inq_varid(ncid, 'y', y_id) + +rc = nf90_inquire_variable(ncid, x_id, dimids=field_dimids) +rc = nf90_inquire_dimension(ncid, field_dimids(1), len=nx) +rc = nf90_inquire_dimension(ncid, field_dimids(2), len=ny) + +! Extract center ("T") points of supergrid +nx = nx / 2 +ny = ny / 2 +allocate(x(nx, ny), y(nx, ny)) +rc = nf90_get_var(ncid, x_id, x, start=[2,2], stride=[2,2]) +rc = nf90_get_var(ncid, y_id, y, start=[2,2], stride=[2,2]) + +rc = nf90_close(ncid) + + +! Read the topographic domain +rc = nf90_open('topog.nc', NF90_NOWRITE, ncid) + +rc = nf90_inq_varid(ncid, 'depth', depth_id) +rc = nf90_inquire_variable(ncid, depth_id, dimids=field_dimids) +rc = nf90_inquire_dimension(ncid, field_dimids(1), len=nx) +rc = nf90_inquire_dimension(ncid, field_dimids(2), len=ny) + +allocate(zbot(nx, ny)) +rc = nf90_get_var(ncid, depth_id, zbot) +rc = nf90_close(ncid) + + +! Construct the vertical axis +allocate(z(nz)) +z = [(i, i=0,nz-1)] * maxval(zbot) / nz + +allocate(temp(nx, ny, nz), salt(nx, ny, nz)) +call t_fc(x, y, z, temp) +salt(:,:,:) = salt0 + + +! Write T/S initial state +rc = nf90_create('temp_salt_ic.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'lon', nx, lon_dimid) +rc = nf90_def_dim(ncid, 'lat', ny, lat_dimid) +rc = nf90_def_dim(ncid, 'depth', nz, depth_dimid) +rc = nf90_def_dim(ncid, 'Time', NF90_UNLIMITED, time_dimid) + +rc = nf90_def_var(ncid, 'depth', NF90_DOUBLE, [depth_dimid], depth_id) +rc = nf90_def_var(ncid, 'lon', NF90_DOUBLE, [lon_dimid], lon_id) +rc = nf90_def_var(ncid, 'lat', NF90_DOUBLE, [lat_dimid], lat_id) +rc = nf90_def_var(ncid, 'Time', NF90_DOUBLE, [time_dimid], time_id) + +rc = nf90_put_att(ncid, time_id, 'calendar', 'noleap') +rc = nf90_put_att(ncid, time_id, 'units', 'days since 0001-01-01 00:00:00.0') +! NOTE: nf90_put_att() truncates empty strings, so use nf90_put_att_any() +rc = nf90_put_att_any(ncid, time_id, 'modulo', NF90_CHAR, 1, ' ') + +rc = nf90_def_var(ncid, 'ptemp', NF90_DOUBLE, & + [lon_dimid, lat_dimid, depth_dimid, time_dimid], temp_id) +rc = nf90_def_var_fill(ncid, temp_id, 0, -1e20_dp) + +rc = nf90_def_var(ncid, 'salt', NF90_DOUBLE, & + [lon_dimid, lat_dimid, depth_dimid, time_dimid], salt_id) +rc = nf90_def_var_fill(ncid, salt_id, 0, -1e20_dp) + +rc = nf90_enddef(ncid) + +rc = nf90_put_var(ncid, lon_id, x(:,1)) +rc = nf90_put_var(ncid, lat_id, y(1,:)) +rc = nf90_put_var(ncid, depth_id, z) +rc = nf90_put_var(ncid, time_id, 0.) +rc = nf90_put_var(ncid, temp_id, temp) +rc = nf90_put_var(ncid, salt_id, salt) + +rc = nf90_close(ncid) + + +! Sponge file +rc = nf90_create('sponge.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'lon', nx, lon_dimid) +rc = nf90_def_dim(ncid, 'lat', ny, lat_dimid) + +rc = nf90_def_var(ncid, 'lon', NF90_DOUBLE, lon_id) +rc = nf90_def_var(ncid, 'lat', NF90_DOUBLE, lat_id) +rc = nf90_def_var(ncid, 'Idamp', NF90_DOUBLE, [lon_dimid, lat_dimid], Idamp_id) +rc = nf90_def_var_fill(ncid, Idamp_id, 0, -1e20_dp) + +rc = nf90_enddef(ncid) + +allocate(Idamp(nx, ny)) +Idamp = 0. +if (dampTime > 0.) & + Idamp(:,:) = 1. / (dampTime * secs_per_day) + +rc = nf90_put_var(ncid, Idamp_id, Idamp) +rc = nf90_put_var(ncid, lon_id, x(:,1)) +rc = nf90_put_var(ncid, lat_id, y(1,:)) + +rc = nf90_close(ncid) + +contains + +subroutine t_fc(x, y, z, tl, radius, tmag) + real(kind=dp), intent(in) :: x(:,:), y(:,:), z(:) + !! Grid positions + real(kind=dp), intent(inout) :: tl(:,:,:) + !! Temperature field on the model grid + real(kind=dp), intent(in), optional :: radius + !! Temperature anomaly radius + real(kind=dp), intent(in), optional :: tmag + !! Temperature anomaly maximum + + real(kind=dp) :: t_rad, t_max + !! Temperature field parameters (radius, max value) + real(kind=dp) :: x0, y0 + !! Center of anomaly (currently midpoint of domain) + real(kind=dp), allocatable :: r(:,:), zd(:) + !! Radial and vertical extent of anomaly + integer :: k, nz + !! Vertical level indexing + + t_rad = 5._dp + if (present(radius)) t_rad = radius + + t_max = 1._dp + if (present(tmag)) t_max = tmag + + ! Reduce supergrid size to T/S grid + allocate(zd, source=z) + + x0 = x(1 + size(x, 1)/2, 1 + size(x, 2)/2) + y0 = y(1 + size(y, 1)/2, 1 + size(y, 2)/2) + + tl(:,:,:) = 0. + nz = size(z) + if (nz > 1) then + zd(:) = z(:) / z(nz) + else + zd(:) = 0. + endif + + allocate(r, source=x) + r(:,:) = hypot(x(:,:) - x0, y(:,:) - y0) + do k = 1, nz + tl(:,:,k) = (1. - min(r(:,:) / t_rad, 1.)) * t_max * (1. - zd(k)) + enddo +end subroutine t_fc + +end diff --git a/.testing/tc4/gen_grid.F90 b/.testing/tc4/gen_grid.F90 new file mode 100644 index 0000000000..e76a681924 --- /dev/null +++ b/.testing/tc4/gen_grid.F90 @@ -0,0 +1,108 @@ +use netcdf + +implicit none + +integer, parameter :: dp = selected_real_kind(10, 100) + !! Double precision (8-byte) + +integer, parameter :: nx = 14, ny = 10 + !! Grid size +real(kind=dp), parameter :: depth0 = 100._dp + !! Uniform depth +real(kind=dp), parameter :: ds = 0.01_dp + !! Grid resolution at the equator in degrees +real(kind=dp), parameter :: Re = 6.378e6_dp + !! Radius of earth +real(kind=dp), parameter :: rad_per_deg = (4. * atan(1._dp)) / 180._dp + !! Degress to radians (= pi/180.) + +integer :: ncid +integer :: nx_id, ny_id, nxp_id, nyp_id, ntile_id, string_id +integer :: depth_id, h2_id +integer :: x_id, y_id, dx_id, dy_id, area_id, angle_id, tile_id + +! Fields on model grid +real(kind=dp) :: depth(nx, ny) + +! Grid fields (defined on supergrid) +real(kind=dp) :: xg(0:2*nx), yg(0:2*ny) +real(kind=dp) :: x(0:2*nx, 0:2*ny), y(0:2*nx, 0:2*ny) +real(kind=dp) :: dx(0:2*nx-1, 0:2*ny) +real(kind=dp) :: dy(0:2*nx, 0:2*ny-1) +real(kind=dp) :: area(0:2*nx-1, 0:2*ny-1) +real(kind=dp) :: angle_dx(0:2*nx, 0:2*ny) + +integer :: i, j, rc + + +! Topography +rc = nf90_create('topog.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'ny', ny, ny_id) +rc = nf90_def_dim(ncid, 'nx', nx, nx_id) +rc = nf90_def_dim(ncid, 'ntiles', 1, ntile_id) + +rc = nf90_def_var(ncid, 'depth', NF90_DOUBLE, [nx_id, ny_id], depth_id) +rc = nf90_def_var(ncid, 'h2', NF90_DOUBLE, [nx_id, ny_id], h2_id) + +rc = nf90_enddef(ncid) + +depth(:,:) = depth0 +rc = nf90_put_var(ncid, depth_id, depth) + +rc = nf90_close(ncid) + + +! Horizontal grid +rc = nf90_create('ocean_hgrid.nc', NF90_CLOBBER, ncid) + +rc = nf90_def_dim(ncid, 'ny', 2*ny, ny_id) +rc = nf90_def_dim(ncid, 'nx', 2*nx, nx_id) +rc = nf90_def_dim(ncid, 'nyp', 2*ny+1, nyp_id) +rc = nf90_def_dim(ncid, 'nxp', 2*nx+1, nxp_id) +rc = nf90_def_dim(ncid, 'string', 5, string_id) + +rc = nf90_def_var(ncid, 'y', NF90_DOUBLE, [nxp_id, nyp_id], y_id) +rc = nf90_def_var(ncid, 'x', NF90_DOUBLE, [nxp_id, nyp_id], x_id) +rc = nf90_def_var(ncid, 'dy', NF90_DOUBLE, [nxp_id, ny_id], dy_id) +rc = nf90_def_var(ncid, 'dx', NF90_DOUBLE, [nx_id, nyp_id], dx_id) +rc = nf90_def_var(ncid, 'area', NF90_DOUBLE, [nx_id, ny_id], area_id) +rc = nf90_def_var(ncid, 'angle_dx', NF90_DOUBLE, [nxp_id, nyp_id], angle_id) +rc = nf90_def_var(ncid, 'tile', NF90_CHAR, string_id, tile_id) + +rc = nf90_put_att(ncid, y_id, 'units', 'degrees') +rc = nf90_put_att(ncid, x_id, 'units', 'degrees') +rc = nf90_put_att(ncid, dy_id, 'units', 'meters') +rc = nf90_put_att(ncid, dx_id, 'units', 'meters') +rc = nf90_put_att(ncid, area_id, 'units', 'm2') +rc = nf90_put_att(ncid, angle_id, 'units', 'degrees') + +rc = nf90_enddef(ncid) + +xg = ds * [(i, i=0, 2*nx)] +yg = ds * [(j, j=0, 2*ny)] + +! NOTE: sin() and cos() are compiler-dependent + +x(:,:) = spread(xg(:), 2, 2*ny+1) +y(:,:) = spread(yg(:), 1, 2*nx+1) +dx(:,:) = rad_per_deg * Re * (x(1:,:) - x(:2*nx-1,:)) & + * cos(0.5 * rad_per_deg * (y(1:,:) + y(:2*nx-1,:))) +dy(:,:) = rad_per_deg * Re * (y(:,1:) - y(:,:2*ny-1)) + +area(:,:) = rad_per_deg * Re * Re & + * spread(sin(rad_per_deg * yg(1:)) - sin(rad_per_deg * yg(:2*ny-1)), 1, 2*nx) & + * spread(xg(1:) - xg(:2*nx-1), 2, 2*ny) + +angle_dx(:,:) = 0. + +rc = nf90_put_var(ncid, x_id, x) +rc = nf90_put_var(ncid, y_id, y) +rc = nf90_put_var(ncid, dx_id, dx) +rc = nf90_put_var(ncid, dy_id, dy) +rc = nf90_put_var(ncid, area_id, area) +rc = nf90_put_var(ncid, angle_id, angle_dx) +rc = nf90_put_var(ncid, tile_id, 'tile1') + +rc = nf90_close(ncid) +end diff --git a/ac/Makefile.in b/ac/Makefile.in index 930816bc8c..43262027e6 100644 --- a/ac/Makefile.in +++ b/ac/Makefile.in @@ -6,6 +6,7 @@ FC = @FC@ LD = @FC@ +PYTHON = @PYTHON@ MAKEDEP = @MAKEDEP@ DEFS = @DEFS@ @@ -32,7 +33,7 @@ rwildcard=$(foreach d,$(wildcard $(1:=/*)),$(call rwildcard,$d,$2) $(filter $(su .PHONY: depend depend: Makefile.dep Makefile.dep: $(MAKEDEP) $(call rwildcard,$(SRC_DIRS),*.h *.c *.inc *.F90) - $(MAKEDEP) -o Makefile.dep -e $(SRC_DIRS) + $(PYTHON) $(MAKEDEP) -o Makefile.dep -e $(SRC_DIRS) # Delete any files associated with configuration (including the Makefile). diff --git a/ac/configure.ac b/ac/configure.ac index 8d74d71fbd..dead0579a6 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -88,8 +88,9 @@ AC_FC_SRCEXT(f90) # - This can cause standard AC_PROG_FC tests to fail if FCFLAGS is configured # with flags from another compiler. # - I do not yet know how to resolve this possible issue. -AX_MPI([], - [AC_MSG_ERROR([Could not find MPI launcher.])]) +AX_MPI([], [ + AC_MSG_ERROR([Could not find MPI launcher.]) +]) # Explicitly replace FC and LD with MPI wrappers @@ -105,7 +106,7 @@ AX_FC_CHECK_MODULE([mpi], # netCDF configuration -# Search for the Fortran netCDF module, fallback to nf-config. +# Search for the Fortran netCDF module. AX_FC_CHECK_MODULE([netcdf], [], [ AS_UNSET([ax_fc_cv_mod_netcdf]) AC_PATH_PROG([NF_CONFIG], [nf-config]) @@ -118,39 +119,37 @@ AX_FC_CHECK_MODULE([netcdf], [], [ ]) ]) -# FMS may invoke netCDF C calls, so we link to libnetcdf. -AC_LANG_PUSH([C]) -AC_CHECK_LIB([netcdf], [nc_create], [], [ - AS_UNSET([ac_cv_lib_netcdf_nc_create]) +# Confirm that the Fortran compiler can link the netCDF C library +AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AS_UNSET([ax_fc_cv_c_lib_netcdf_nc_create]) AC_PATH_PROG([NC_CONFIG], [nc-config]) AS_IF([test -n "$NC_CONFIG"], [ - AC_SUBST([LDFLAGS], - ["$LDFLAGS -L$($NC_CONFIG --libdir)"] - ) - ], [AC_MSG_ERROR([Could not find nc-config.])] - ) - AC_CHECK_LIB([netcdf], [nc_create], [], [ - AC_MSG_ERROR([Could not find libnetcdf.]) + AC_SUBST([LDFLAGS], ["$LDFLAGS -L$($NC_CONFIG --libdir)"]) + ], [ + AC_MSG_ERROR([Could not find nc-config.]) + ]) + AX_FC_CHECK_C_LIB([netcdf], [nc_create], [], [ + AC_MSG_ERROR([Could not find netCDF C library.]) ]) ]) -AC_LANG_POP([C]) - -# NOTE: We test for nf_create, rather than nf90_create, because AX_FC_CHECK_LIB -# is currently not yet able to properly probe inside modules. -# NOTE: nf-config does not have --libdir, so we use the first term of flibs. -# Link to Fortran netCDF library, netcdff +# Confirm that the Fortran compiler can link to the netCDF Fortran library. +# NOTE: +# - We test nf_create, rather than nf90_create, since AX_FC_CHECK_LIB can +# not currently probe the Fortran 90 interfaces. +# - nf-config does not have --libdir, so we parse the --flibs output. AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ AS_UNSET([ax_fc_cv_lib_netcdff_nf_create]) AC_PATH_PROG([NF_CONFIG], [nf-config]) AS_IF([test -n "$NF_CONFIG"], [ AC_SUBST([LDFLAGS], - ["$LDFLAGS $($NF_CONFIG --flibs | cut -f1 -d" ")"] + ["$LDFLAGS $($NF_CONFIG --flibs | xargs -n1 | grep "^-L" | sort -u | xargs)"] ) - ], [AC_MSG_ERROR([Could not find nf_create.])] - ) + ], [ + AC_MSG_ERROR([Could not find nf-config.]) + ]) AX_FC_CHECK_LIB([netcdff], [nf_create], [], [], [ - AC_MSG_ERROR([Could not find libnetcdff.]) + AC_MSG_ERROR([Could not find netCDF Fortran library.]) ]) ]) @@ -222,6 +221,13 @@ AC_COMPILE_IFELSE( ) +# Verify that Python is available +AC_PATH_PROGS([PYTHON], [python python3 python2], [ + AC_MSG_ERROR([Could not find python.]) +]) +AC_ARG_VAR([PYTHON], [Python interpreter command]) + + # Verify that makedep is available AC_PATH_PROG([MAKEDEP], [makedep], [${srcdir}/ac/makedep]) AC_SUBST([MAKEDEP]) @@ -235,13 +241,13 @@ AC_CONFIG_COMMANDS(Makefile.dep, [make depend]) # POSIX verification tests -AC_LANG_PUSH([C]) # These symbols may be defined as macros, making them inaccessible by Fortran. -# The following exist in BSD and Linux, so we just test for them. -AC_CHECK_FUNC([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])]) -AC_CHECK_FUNC([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])]) -AC_CHECK_FUNC([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) +# These three exist in modern BSD and Linux libc, so we just confirm them. +# But one day, we many need to handle them more carefully. +AX_FC_CHECK_BIND_C([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])]) +AX_FC_CHECK_BIND_C([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])]) +AX_FC_CHECK_BIND_C([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) # Determine the sigsetjmp symbol. If missing, then point to sigsetjmp_missing. # @@ -250,14 +256,20 @@ AC_CHECK_FUNC([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) # __sigsetjmp glibc (Linux) SIGSETJMP="sigsetjmp_missing" for sigsetjmp_fn in sigsetjmp __sigsetjmp; do - AC_CHECK_FUNC([${sigsetjmp_fn}], [ + AX_FC_CHECK_BIND_C([${sigsetjmp_fn}], [ SIGSETJMP=${sigsetjmp_fn} break ]) done AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["${SIGSETJMP}"]) -# Determine the size of jmp_buf and sigjmp_buf +# Verify the size of nonlocal jump buffer structs +# NOTE: This requires C compiler, but can it be done with a Fortran compiler? +AC_LANG_PUSH([C]) + +AX_MPI([], [AC_MSG_ERROR([Could not find MPI launcher.])]) +AC_SUBST([CC], [$MPICC]) + AC_CHECK_SIZEOF([jmp_buf], [], [#include ]) AC_CHECK_SIZEOF([sigjmp_buf], [], [#include ]) @@ -268,4 +280,3 @@ AC_LANG_POP([C]) AC_SUBST([CPPFLAGS]) AC_CONFIG_FILES([Makefile:${srcdir}/ac/Makefile.in]) AC_OUTPUT - diff --git a/ac/deps/Makefile.fms.in b/ac/deps/Makefile.fms.in index e2581cf817..caf4abb9c7 100644 --- a/ac/deps/Makefile.fms.in +++ b/ac/deps/Makefile.fms.in @@ -8,6 +8,7 @@ CC = @CC@ FC = @FC@ LD = @FC@ AR = @AR@ +PYTHON = @PYTHON@ MAKEDEP = @MAKEDEP@ DEFS = @DEFS@ @@ -22,4 +23,4 @@ ARFLAGS = @ARFLAGS@ .PHONY: depend depend: Makefile.dep Makefile.dep: - $(MAKEDEP) -o Makefile.dep -e -x libFMS.a @srcdir@ + $(PYTHON) $(MAKEDEP) -o Makefile.dep -e -x libFMS.a @srcdir@ diff --git a/ac/deps/configure.fms.ac b/ac/deps/configure.fms.ac index 4e0c0f1390..a52533970b 100644 --- a/ac/deps/configure.fms.ac +++ b/ac/deps/configure.fms.ac @@ -158,7 +158,14 @@ AX_FC_ALLOW_ARG_MISMATCH FCFLAGS="$FCFLAGS $ALLOW_ARG_MISMATCH_FCFLAGS" -# Verify makedep +# Verify that Python is available +AC_PATH_PROGS([PYTHON], [python python3 python2], [ + AC_MSG_ERROR([Could not find python.]) +]) +AC_ARG_VAR([PYTHON], [Python interpreter command]) + + +# Verify that makedep is available AC_PATH_PROGS([MAKEDEP], [makedep], [], ["${PATH}:${srcdir}/../../.."]) AS_IF([test -n "${MAKEDEP}"], [ AC_SUBST([MAKEDEP]) diff --git a/ac/m4/ax_fc_check_bind_c.m4 b/ac/m4/ax_fc_check_bind_c.m4 new file mode 100644 index 0000000000..9b9f821d4c --- /dev/null +++ b/ac/m4/ax_fc_check_bind_c.m4 @@ -0,0 +1,42 @@ +dnl AX_FC_CHECK_C_LIB(FUNCTION, +dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND], +dnl [OTHER-LDFLAGS], [OTHER-LIBS]) +dnl +dnl This macro checks if a C binding is available to the compiler. +dnl +dnl Equivalently, it checks if the Fortran compiler can see a C function. +dnl +dnl Results are cached in `ax_fc_cv_bind_c_FUNCTION`. +dnl +AC_DEFUN([AX_FC_CHECK_BIND_C], [ + AS_VAR_PUSHDEF([ax_fc_Bind_C], [ax_fc_cv_bind_c_$1]) + m4_ifval([$4], + [ax_fc_bind_c_msg_LDFLAGS=" with $4"], + [ax_fc_bind_c_msg_LDFLAGS=""] + ) + AC_CACHE_CHECK( + [if $FC can bind $1$ax_fc_bind_c_msg_LDFLAGS], [ax_fc_cv_bind_c_$1], [ + ax_fc_check_bind_c_save_LDFLAGS=$LDFLAGS + LDFLAGS="$4 $LDFLAGS" + ax_fc_check_bind_c_save_LIBS=$LIBS + LIBS="$5 $LIBS" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([],[dnl +dnl begin code block + interface + subroutine test() bind(c, name="$1") + end subroutine test + end interface + call test]) +dnl end code block + ], + [AS_VAR_SET([ax_fc_Bind_C], [yes])], + [AS_VAR_SET([ax_fc_Bind_C], [no])] + ) + LDFLAGS=$ax_fc_check_bind_c_save_LDFLAGS + LIBS=$ax_fc_check_bind_c_save_LIBS + ] + ) + AS_VAR_IF([ax_fc_Bind_C], [yes], [$2], [$3]) + AS_VAR_POPDEF([ax_fc_Bind_C]) +]) diff --git a/ac/m4/ax_fc_check_c_lib.m4 b/ac/m4/ax_fc_check_c_lib.m4 new file mode 100644 index 0000000000..af5765282a --- /dev/null +++ b/ac/m4/ax_fc_check_c_lib.m4 @@ -0,0 +1,45 @@ +dnl AX_FC_CHECK_C_LIB(LIBRARY, FUNCTION, +dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND], +dnl [OTHER-LDFLAGS], [OTHER-LIBS]) +dnl +dnl This macro checks if a C library can be referenced by a Fortran compiler. +dnl +dnl Results are cached in `ax_fc_cv_c_lib_LIBRARY_FUNCTION`. +dnl +dnl NOTE: Might be possible to rewrite this to use `AX_FC_CHECK_BIND_C`. +dnl +AC_DEFUN([AX_FC_CHECK_C_LIB], [ + AS_VAR_PUSHDEF([ax_fc_C_Lib], [ax_fc_cv_c_lib_$1_$2]) + m4_ifval([$5], + [ax_fc_c_lib_msg_LDFLAGS=" with $5"], + [ax_fc_c_lib_msg_LDFLAGS=""] + ) + AC_CACHE_CHECK( + [for $2 in -l$1$ax_fc_c_lib_msg_LDFLAGS], [ax_fc_cv_c_lib_$1_$2], [ + ax_fc_check_c_lib_save_LDFLAGS=$LDFLAGS + LDFLAGS="$6 $LDFLAGS" + ax_fc_check_c_lib_save_LIBS=$LIBS + LIBS="-l$1 $7 $LIBS" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([],[dnl +dnl begin code block + interface + subroutine test() bind(c, name="$2") + end subroutine test + end interface + call test]) +dnl end code block + ], + [AS_VAR_SET([ax_fc_C_Lib], [yes])], + [AS_VAR_SET([ax_fc_C_Lib], [no])] + ) + LDFLAGS=$ax_fc_check_c_lib_save_LDFLAGS + LIBS=$ax_fc_check_c_lib_save_LIBS + ] + ) + AS_VAR_IF([ax_fc_C_Lib], [yes], + [m4_default([$3], [LIBS="-l$1 $LIBS"])], + [$4] + ) + AS_VAR_POPDEF([ax_fc_C_Lib]) +]) diff --git a/ac/makedep b/ac/makedep index 443371a79f..439679f17d 100755 --- a/ac/makedep +++ b/ac/makedep @@ -6,7 +6,8 @@ import argparse import glob import os import re -import sys # used only to get path to current script +import sys # used only to get path to current script + # Pre-compile re searches re_module = re.compile(r"^ *module +([a-z_0-9]+)") @@ -15,7 +16,9 @@ re_cpp_include = re.compile(r"^ *# *include *[<\"']([a-zA-Z_0-9\.]+)[>\"']") re_f90_include = re.compile(r"^ *include +[\"']([a-zA-Z_0-9\.]+)[\"']") re_program = re.compile(r"^ *[pP][rR][oO][gG][rR][aA][mM] +([a-zA-Z_0-9]+)") -def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, script_path): + +def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, + link_externals, script_path): """Create "makefile" after scanning "src_dis".""" # Scan everything Fortran related @@ -23,134 +26,147 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, # Lists of things # ... all F90 source - F90_files = [f for f in all_files if f.endswith('.f90') or f.endswith('.F90')] + F90_files = [ + f for f in all_files + if f.endswith('.f90') or f.endswith('.F90') + ] # ... all C source c_files = [f for f in all_files if f.endswith('.c')] # Dictionaries for associating files to files # maps basename of file to full path to file - f2F = dict( zip( [os.path.basename(f) for f in all_files], all_files ) ) + f2F = dict(zip([os.path.basename(f) for f in all_files], all_files)) # maps basename of file to directory - f2dir = dict( zip( [os.path.basename(f) for f in all_files], [os.path.dirname(f) for f in all_files] ) ) + f2dir = dict(zip([os.path.basename(f) for f in all_files], + [os.path.dirname(f) for f in all_files])) # Check for duplicate files in search path if not len(f2F) == len(all_files): a = [] for f in all_files: if os.path.basename(f) in a: - print('Warning: File %s was found twice! One is being ignored but which is undefined.'%(os.path.basename(f))) - a.append( os.path.basename(f) ) + print('Warning: File {} was found twice! One is being ignored ' + 'but which is undefined.'.format(os.path.basename(f))) + a.append(os.path.basename(f)) # maps object file to F90 source - o2F90 = dict( zip( [ object_file(f) for f in F90_files ], F90_files ) ) + o2F90 = dict(zip([object_file(f) for f in F90_files], F90_files)) # maps object file to C source - o2c = dict( zip( [ object_file(f) for f in c_files ], c_files ) ) + o2c = dict(zip([object_file(f) for f in c_files], c_files)) o2mods, o2uses, o2h, o2inc, o2prg, prg2o, mod2o = {}, {}, {}, {}, {}, {}, {} externals, all_modules = [], [] for f in F90_files: - mods, used, cpp, inc, prg = scan_fortran_file( f ) + mods, used, cpp, inc, prg = scan_fortran_file(f) # maps object file to modules produced - o2mods[ object_file(f) ] = mods + o2mods[object_file(f)] = mods # maps module produced to object file for m in mods: - mod2o[ m ] = object_file(f) + mod2o[m] = object_file(f) # maps object file to modules used - o2uses[ object_file(f) ] = used + o2uses[object_file(f)] = used # maps object file to .h files included - o2h[ object_file(f) ] = cpp + o2h[object_file(f)] = cpp # maps object file to .inc files included - o2inc[ object_file(f) ] = inc + o2inc[object_file(f)] = inc # maps object file to executables produced - o2prg[ object_file(f) ] = prg + o2prg[object_file(f)] = prg if prg: for p in prg: if p in prg2o.keys(): - #raise ValueError("Files %s and %s both create the same program '%s'"%( + # raise ValueError("Files %s and %s both create the same program '%s'"%( # f,o2F90[prg2o[p]],p)) - print("Warning: Files %s and %s both create the same program '%s'"%( - f,o2F90[prg2o[p]],p)) - o = prg2o[ p ] - del prg2o[ p ] - #del o2prg[ o ] - need to keep so modifying instead - o2prg[ o ] = [ '[ignored %s]'%(p) ] + print("Warning: Files {} and {} both create the same " + "program '{}'".format(f, o2F90[prg2o[p]], p)) + o = prg2o[p] + del prg2o[p] + # del o2prg[o] - need to keep so modifying instead + o2prg[o] = ['[ignored %s]' % (p)] else: - prg2o[ p ] = object_file(f) + prg2o[p] = object_file(f) if not mods and not prg: - externals.append( object_file(f) ) + externals.append(object_file(f)) all_modules += mods for f in c_files: - _, _, cpp, inc, _ = scan_fortran_file( f ) + _, _, cpp, inc, _ = scan_fortran_file(f) # maps object file to .h files included - o2h[ object_file(f) ] = cpp + o2h[object_file(f)] = cpp + externals.append(object_file(f)) # Are we building a library, single or multiple executables? targ_libs = [] if exec_target: if exec_target.endswith('.a'): - targ_libs.append( exec_target ) + targ_libs.append(exec_target) else: if len(prg2o.keys()) == 1: o = prg2o.values()[0] - del prg2o[ o2prg[o][0] ] - prg2o[ exec_target ] = o - o2prg[ o ] = exec_target + del prg2o[o2prg[o][0]] + prg2o[exec_target] = o + o2prg[o] = exec_target else: - raise ValueError("Option -x specified an executable name but none or multiple programs were found") - targets = [ exec_target ] + raise ValueError("Option -x specified an executable name but " + "none or multiple programs were found") + targets = [exec_target] else: if len(prg2o.keys()) == 0: - print("Warning: No programs were found and -x did not specify a library to build") + print("Warning: No programs were found and -x did not specify a " + "library to build") targets = prg2o.keys() # Create new makefile with open(makefile, 'w') as file: - print("# %s created by makedep"%(makefile), file=file) + print("# %s created by makedep" % (makefile), file=file) print("", file=file) print("# Invoked as", file=file) print('# '+' '.join(sys.argv), file=file) print("", file=file) - print("all:", " ".join( targets ), file=file) + print("all:", " ".join(targets), file=file) print("", file=file) - #print("# SRC_DIRS is usually set in the parent Makefile but in case is it not we", file=file) - #print("# record it here from when makedep was previously invoked.", file=file) - #print("SRC_DIRS ?= ${SRC_DIRS}", file=file) - #print("", file=file) + # print("# SRC_DIRS is usually set in the parent Makefile but in case is it not we", file=file) + # print("# record it here from when makedep was previously invoked.", file=file) + # print("SRC_DIRS ?= ${SRC_DIRS}", file=file) + # print("", file=file) - #print("# all_files:", ' '.join(all_files), file=file) - #print("", file=file) + # print("# all_files:", ' '.join(all_files), file=file) + # print("", file=file) # Write rule for each object from Fortran - for o in sorted( o2F90.keys() ): + for o in sorted(o2F90.keys()): found_mods = [m for m in o2uses[o] if m in all_modules] + found_objs = [mod2o[m] for m in o2uses[o] if m in all_modules] + found_deps = [ + dep for pair in zip(found_mods, found_objs) for dep in pair + ] missing_mods = [m for m in o2uses[o] if m not in all_modules] - incs = nested_inc( o2h[o] + o2inc[o], f2F ) - incdeps = sorted( set( [ f2F[f] for f in incs if f in f2F ] ) ) - incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) + incs = nested_inc(o2h[o] + o2inc[o], f2F) + incdeps = sorted(set([f2F[f] for f in incs if f in f2F])) + incargs = sorted(set(['-I'+os.path.dirname(f) for f in incdeps])) if debug: - print("# Source file %s produces:"%(o2F90[o]), file=file) + print("# Source file {} produces:".format(o2F90[o]), file=file) print("# object:", o, file=file) print("# modules:", ' '.join(o2mods[o]), file=file) print("# uses:", ' '.join(o2uses[o]), file=file) - print("# found:", ' '.join(found_mods), file=file) + print("# found mods:", ' '.join(found_mods), file=file) + print("# found objs:", ' '.join(found_objs), file=file) print("# missing:", ' '.join(missing_mods), file=file) print("# includes_all:", ' '.join(incs), file=file) print("# includes_pth:", ' '.join(incdeps), file=file) print("# incargs:", ' '.join(incargs), file=file) print("# program:", ' '.join(o2prg[o]), file=file) if o2mods[o]: - print(' '.join(o2mods[o])+':',o, file=file) - print(o+':', o2F90[o], ' '.join(incdeps+found_mods), file=file) + print(' '.join(o2mods[o])+':', o, file=file) + print(o + ':', o2F90[o], ' '.join(incdeps+found_deps), file=file) print('\t'+fc_rule, ' '.join(incargs), file=file) # Write rule for each object from C - for o in sorted( o2c.keys() ): - incdeps = sorted( set( [ f2F[h] for h in o2h[o] if h in f2F ] ) ) - incargs = sorted( set( [ '-I'+os.path.dirname(f) for f in incdeps ] ) ) + for o in sorted(o2c.keys()): + incdeps = sorted(set([f2F[h] for h in o2h[o] if h in f2F])) + incargs = sorted(set(['-I'+os.path.dirname(f) for f in incdeps])) if debug: - print("# Source file %s produces:"%(o2c[o]), file=file) + print("# Source file %s produces:" % (o2c[o]), file=file) print("# object:", o, file=file) print("# includes_all:", ' '.join(o2h[o]), file=file) print("# includes_pth:", ' '.join(incdeps), file=file) @@ -161,23 +177,24 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, # Externals (so called) if link_externals: print("", file=file) - print("# Note: The following object files are not associated with modules so we assume we should link with them:", file=file) + print("# Note: The following object files are not associated with " + "modules so we assume we should link with them:", file=file) print("# ", ' '.join(externals), file=file) o2x = None else: externals = [] # Write rules for linking executables - for p in sorted( prg2o.keys() ): + for p in sorted(prg2o.keys()): o = prg2o[p] print("", file=file) - print(p+':',' '.join( link_obj(o, o2uses, mod2o, all_modules) + externals ), file=file ) + print(p+':', ' '.join(link_obj(o, o2uses, mod2o, all_modules) + externals), file=file) print('\t$(LD) $(LDFLAGS) -o $@ $^ $(LIBS)', file=file) # Write rules for building libraries - for l in sorted( targ_libs ): + for lb in sorted(targ_libs): print("", file=file) - print(l+':',' '.join( list(o2F90.keys()) + list(o2c.keys()) ), file=file ) + print(lb+':', ' '.join(list(o2F90.keys()) + list(o2c.keys())), file=file) print('\t$(AR) $(ARFLAGS) $@ $^', file=file) # Write cleanup rules @@ -190,112 +207,144 @@ def create_deps(src_dirs, makefile, debug, exec_target, fc_rule, link_externals, print("remakedep:", file=file) print('\t'+' '.join(sys.argv), file=file) + def link_obj(obj, o2uses, mod2o, all_modules): """List of all objects needed to link "obj",""" def recur(obj, depth=0): if obj not in olst: - olst.append( obj) + olst.append(obj) else: return uses = [m for m in o2uses[obj] if m in all_modules] - if len(uses)>0: + if len(uses) > 0: ouses = [mod2o[m] for m in uses] for m in uses: o = mod2o[m] recur(o, depth=depth+1) - #if o not in olst: + # if o not in olst: # recur(o, depth=depth+1) - # olst.append( o ) + # olst.append(o) return return olst = [] recur(obj) - return sorted( set( olst) ) + return sorted(set(olst)) + def nested_inc(inc_files, f2F): - """List of all files included by "inc_files", either by #include or F90 include.""" + """List of all files included by "inc_files", either by #include or F90 + include.""" def recur(hfile): if hfile not in f2F.keys(): return - _, _, cpp, inc, _ = scan_fortran_file( f2F[hfile] ) - if len(cpp)+len(inc)>0: + _, _, cpp, inc, _ = scan_fortran_file(f2F[hfile]) + if len(cpp) + len(inc) > 0: for h in cpp+inc: if h not in hlst and h in f2F.keys(): recur(h) - hlst.append( h ) + hlst.append(h) return return hlst = [] for h in inc_files: recur(h) - return inc_files + sorted( set( hlst ) ) + return inc_files + sorted(set(hlst)) + def scan_fortran_file(src_file): - """Scan the Fortran file "src_file" and return lists of module defined, module used, and files included.""" + """Scan the Fortran file "src_file" and return lists of module defined, + module used, and files included.""" module_decl, used_modules, cpp_includes, f90_includes, programs = [], [], [], [], [] with open(src_file, 'r') as file: lines = file.readlines() for line in lines: - match = re_module.match( line.lower() ) + match = re_module.match(line.lower()) if match: - if match.group(1) not in 'procedure': # avoid "module procedure" statements - module_decl.append( match.group(1) ) - match = re_use.match( line.lower() ) + if match.group(1) not in 'procedure': # avoid "module procedure" statements + module_decl.append(match.group(1)) + match = re_use.match(line.lower()) if match: - used_modules.append( match.group(1) ) - match = re_cpp_include.match( line ) + used_modules.append(match.group(1)) + match = re_cpp_include.match(line) if match: - cpp_includes.append( match.group(1) ) - match = re_f90_include.match( line ) + cpp_includes.append(match.group(1)) + match = re_f90_include.match(line) if match: - f90_includes.append( match.group(1) ) - match = re_program.match( line ) + f90_includes.append(match.group(1)) + match = re_program.match(line) if match: - programs.append( match.group(1) ) + programs.append(match.group(1)) used_modules = [m for m in sorted(set(used_modules)) if m not in module_decl] - return add_suff(module_decl, '.mod'), add_suff( used_modules, '.mod'), cpp_includes, f90_includes, programs - #return add_suff(module_decl, '.mod'), add_suff( sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs + return add_suff(module_decl, '.mod'), add_suff(used_modules, '.mod'), cpp_includes, f90_includes, programs + # return add_suff(module_decl, '.mod'), add_suff(sorted(set(used_modules)), '.mod'), cpp_includes, f90_includes, programs + def object_file(src_file): - """Return the name of an object file that results from compiling src_file.""" - return os.path.splitext( os.path.basename( src_file ) )[0] + '.o' + """Return the name of an object file that results from compiling + src_file.""" + return os.path.splitext(os.path.basename(src_file))[0] + '.o' def find_files(src_dirs): - """Return sorted list of all source files starting from each directory in the list "src_dirs".""" + """Return sorted list of all source files starting from each directory in + the list "src_dirs".""" files = [] for path in src_dirs: if not os.path.isdir(path): - raise ValueError("Directory '%s' was not found"%(path)) - for p, d, f in os.walk( os.path.normpath(path), followlinks=True): + raise ValueError("Directory '{}' was not found".format(path)) + for p, d, f in os.walk(os.path.normpath(path), followlinks=True): for file in f: - if file.endswith('.F90') or file.endswith('.f90') or file.endswith('.h') or file.endswith('.inc') or file.endswith('.c'): + # TODO: use any() + if (file.endswith('.F90') or file.endswith('.f90') + or file.endswith('.h') or file.endswith('.inc') + or file.endswith('.c')): files.append(p+'/'+file) - return sorted( set( files ) ) + return sorted(set(files)) + def add_suff(lst, suff): """Add "suff" to each item in the list""" - return [ f+suff for f in lst ] + return [f + suff for f in lst] + # Parse arguments parser = argparse.ArgumentParser( - description="Generate make dependencies for F90 source code.") -parser.add_argument('path', nargs='+', - help="Directories to search for source code.") -parser.add_argument('-o', '--makefile', default='Makefile.dep', - help="Name of Makefile to put dependencies in to. Default is Makefile.dep.") -parser.add_argument('-f', '--fc_rule', default="$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<", - help="""String to use in the compilation rule. Default is: - '$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'""") -parser.add_argument('-x', '--exec_target', - help="""Name of executable to build. - Fails if more than one program is found. - If EXEC ends in .a then a library is built.""") -parser.add_argument('-e', '--link_externals', action='store_true', - help="Always compile and link any files that do not produce modules (externals).") -parser.add_argument('-d', '--debug', action='store_true', - help="Annotate the makefile with extra information.") + description="Generate make dependencies for F90 source code." +) +parser.add_argument( + 'path', + nargs='+', + help="Directories to search for source code." +) +parser.add_argument( + '-o', '--makefile', + default='Makefile.dep', + help="Name of Makefile to put dependencies in to. Default is Makefile.dep." +) +parser.add_argument( + '-f', '--fc_rule', + default="$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<", + help="String to use in the compilation rule. Default is: " + "'$(FC) $(DEFS) $(FCFLAGS) $(CPPFLAGS) -c $<'" +) +parser.add_argument( + '-x', '--exec_target', + help="Name of executable to build. Fails if more than one program is " + "found. If EXEC ends in .a then a library is built." +) +parser.add_argument( + '-e', '--link_externals', + action='store_true', + help="Always compile and link any files that do not produce modules " + "(externals)." +) +parser.add_argument( + '-d', '--debug', + action='store_true', + help="Annotate the makefile with extra information." +) args = parser.parse_args() # Do the thing -create_deps(args.path, args.makefile, args.debug, args.exec_target, args.fc_rule, args.link_externals, sys.argv[0]) +create_deps(args.path, args.makefile, args.debug, args.exec_target, + args.fc_rule, args.link_externals, sys.argv[0]) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 90797027c6..88d2cb3f42 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -28,6 +28,7 @@ module MOM_surface_forcing_gfdl use MOM_interpolate, only : init_external_field, time_interp_external use MOM_interpolate, only : time_interp_external_init use MOM_io, only : slasher, write_version_number, MOM_read_data +use MOM_io, only : read_netCDF_data use MOM_io, only : stdout_if_root use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state @@ -82,17 +83,17 @@ module MOM_surface_forcing_gfdl !! type without any further adjustments to drive the ocean dynamics. !! The actual net mass source may differ due to corrections. - real :: gust_const !< Constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< Constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL() !< Turbulent kinetic energy introduced to the bottom boundary layer !! by drag on the tidal flows [R Z3 T-3 ~> W m-2]. real, pointer, dimension(:,:) :: & gust => NULL() !< A spatially varying unresolved background gustiness that - !! contributes to ustar [R L Z T-1 ~> Pa]. gust is used when read_gust_2d is true. + !! contributes to ustar [R L Z T-2 ~> Pa]. gust is used when read_gust_2d is true. real, pointer, dimension(:,:) :: & ustar_tidal => NULL() !< Tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] - real :: cd_tides !< Drag coefficient that applies to the tides (nondimensional) + real :: cd_tides !< Drag coefficient that applies to the tides [nondim] real :: utide !< Constant tidal velocity to use if read_tideamp is false [Z T-1 ~> m s-1]. logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. @@ -110,7 +111,6 @@ module MOM_surface_forcing_gfdl !! salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to restore sea !! surface temperature to a specified value. - real :: Flux_const !< Piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_salt !< Piston velocity for surface salt restoring [Z T-1 ~> m s-1] real :: Flux_const_temp !< Piston velocity for surface temp restoring [Z T-1 ~> m s-1] logical :: trestore_SPEAR_ECDA !< If true, modify restoring data wrt local SSS @@ -128,7 +128,7 @@ module MOM_surface_forcing_gfdl logical :: mask_srestore_marginal_seas !< If true, then mask SSS restoring in marginal seas real :: max_delta_srestore !< Maximum delta salinity used for restoring [S ~> ppt] real :: max_delta_trestore !< Maximum delta sst used for restoring [C ~> degC] - real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin [nondim] integer :: answer_date !< The vintage of the order of arithmetic and expressions in the !! gustiness calculations. Values below 20190101 recover the answers !! from the end of 2018, while higher values use a simpler expression @@ -145,14 +145,14 @@ module MOM_surface_forcing_gfdl !! salinity restoring fluxes. The masking file should be !! in inputdir/salt_restore_mask.nc and the field should !! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring [nondim] character(len=200) :: temp_restore_file !< Filename for sst restoring data character(len=30) :: temp_restore_var_name !< Name of surface temperature in temp_restore_file logical :: mask_trestore !< If true, apply a 2-dimensional mask to the surface !! temperature restoring fluxes. The masking file should be !! in inputdir/temp_restore_mask.nc and the field should !! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< Mask for SST restoring [nondim] integer :: id_srestore = -1 !< An id number for time_interp_external. integer :: id_trestore = -1 !< An id number for time_interp_external. @@ -221,7 +221,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. real, intent(in) :: valid_time !< The amount of time over which these fluxes - !! should be applied [s]. + !! should be applied [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a @@ -251,7 +251,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! mass fluxes [R Z s m2 kg-1 T-1 ~> 1] real :: rhoXcp ! Reference density times heat capacity times unit scaling ! factors [Q R C-1 ~> J m-3 degC-1] - real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. + real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1 [nondim] call cpu_clock_begin(id_clock_forcing) @@ -333,7 +333,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Indicate that there are new unused fluxes. fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*valid_time + fluxes%dt_buoy_accum = valid_time fluxes%heat_added(:,:) = 0.0 fluxes%salt_flux_added(:,:) = 0.0 @@ -581,7 +581,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, US%s_to_T*valid_time, G, US, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, valid_time, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged @@ -663,7 +663,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ !! previous call to surface_forcing_init. real, optional, intent(in) :: dt_forcing !< A time interval over which to apply the !! current value of ustar as a weighted running - !! average [s], or if 0 do not average ustar. + !! average [T ~> s], or if 0 do not average ustar. !! Missing is equivalent to 0. logical, optional, intent(in) :: reset_avg !< If true, reset the time average. @@ -1170,7 +1170,10 @@ subroutine apply_force_adjustments(G, US, CS, Time, forces) real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points [R Z L T-2 ~> Pa] integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau + real :: dLonDx, dLonDy ! The change in longitude across the cell in the x- and y-directions [degrees_E] + real :: rDlon ! The magnitude of the change in longitude [degrees_E] and then its inverse [degrees_E-1] + real :: cosA, sinA ! The cosine and sine of the angle between the grid and true north [nondim] + real :: zonal_tau, merid_tau ! True zonal and meridional wind stresses [R Z L T-2 ~> Pa] real :: Pa_conversion ! A unit conversion factor from Pa to the internal units [R Z L T-2 Pa-1 ~> 1] logical :: overrode_x, overrode_y @@ -1244,19 +1247,22 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) !! diagnostic output type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module - integer, optional, intent(in) :: wind_stagger !< If present, the staggering of the winds that are - !! being provided in calls to update_ocean_model + integer, optional, intent(in) :: wind_stagger !< If present, the staggering of the winds + !! that are being provided in calls to update_ocean_model ! Local variables - real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. - type(directories) :: dirs - logical :: new_sim, iceberg_flux_diags + real :: utide ! The RMS tidal velocity [Z T-1 ~> m s-1]. + real :: Flux_const_dflt ! A default piston velocity for restoring surface properties [m day-1] + logical :: new_sim ! False if this simulation was started from a restart file + ! or other equivalent files. + logical :: iceberg_flux_diags ! If true, diagnostics of fluxes from icebergs are available. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover ! the answers from the end of 2018. Otherwise, use a simpler ! expression to calculate gustiness. type(time_type) :: Time_frc + type(directories) :: dirs ! A structure containing relevant directory paths and input filenames. character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1265,7 +1271,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) character(len=48) :: flnam character(len=240) :: basin_file integer :: i, j, isd, ied, jsd, jed - real :: unscaled_fluxconst isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -1386,16 +1391,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "production runs.", units="nondim", default=1.0) if (CS%restore_salt) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", Flux_const_dflt, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s, unscaled=unscaled_fluxconst) + units="m day-1", default=0.0) call get_param(param_file, mdl, "FLUXCONST_SALT", CS%Flux_const_salt, & "The constant that relates the restoring surface salt fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - fail_if_missing=.false., default=unscaled_fluxconst, units="m day-1", scale=US%m_to_Z*US%T_to_s) - ! Finish converting CS%Flux_const from m day-1 to [Z T-1 ~> m s-1]. - CS%Flux_const = CS%Flux_const / 86400.0 + units="m day-1", default=Flux_const_dflt, scale=US%m_to_Z*US%T_to_s) + ! Finish converting CS%Flux_const_salt from m day-1 to [Z T-1 ~> m s-1]. Ideally this would be + ! included in the scale factors above, but doing so would change answers because a/b /= a*(1/b). CS%Flux_const_salt = CS%Flux_const_salt / 86400.0 call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & "A file in which to find the surface salinity to use for restoring.", & @@ -1437,16 +1442,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) endif if (CS%restore_temp) then - call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", Flux_const_dflt, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s, unscaled=unscaled_fluxconst) + units="m day-1", default=0.0) call get_param(param_file, mdl, "FLUXCONST_TEMP", CS%Flux_const_temp, & "The constant that relates the restoring surface temperature fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - fail_if_missing=.false., default=unscaled_fluxconst, units="m day-1", scale=US%m_to_Z*US%T_to_s) - ! Convert CS%Flux_const from m day-1 to m s-1. - CS%Flux_const = CS%Flux_const / 86400.0 + units="m day-1", default=Flux_const_dflt, scale=US%m_to_Z*US%T_to_s) + ! Finish converting CS%Flux_const_temp from [m day-1] to [Z T-1 ~> m s-1]. Ideally this would be + ! included in the scale factors above, but doing so would change answers because a/b /= a*(1/b). CS%Flux_const_temp = CS%Flux_const_temp / 86400.0 call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & "A file in which to find the surface temperature to use for restoring.", & @@ -1503,7 +1508,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1, scale=US%m_to_Z*US%T_to_s) + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(TideAmp_file, 'tideamp', CS%TKE_tidal, G%Domain, & + rescale=US%m_to_Z*US%T_to_s) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) @@ -1533,8 +1541,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(gust_file, 'gustiness', CS%gust, G%domain, timelevel=1, & - scale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(gust_file, 'gustiness', CS%gust, G%Domain, & + rescale=US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z) ! units in file should be Pa endif call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & @@ -1713,8 +1723,8 @@ end subroutine ice_ocn_bnd_type_chksum !> Check the values passed by IOB over land are zero subroutine check_mask_val_consistency(val, mask, i, j, varname, G) - real, intent(in) :: val !< value of flux/variable passed by IOB - real, intent(in) :: mask !< value of ocean mask + real, intent(in) :: val !< value of flux/variable passed by IOB [various] + real, intent(in) :: mask !< value of ocean mask [nondim] integer, intent(in) :: i !< model grid cell indices integer, intent(in) :: j !< model grid cell indices character(len=*), intent(in) :: varname !< variable name diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index a12ab35240..005e3a6723 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -21,7 +21,7 @@ module ocean_model_mod use MOM_coupler_types, only : coupler_type_spawn, coupler_type_write_chksums use MOM_coupler_types, only : coupler_type_initialized, coupler_type_copy_data use MOM_coupler_types, only : coupler_type_set_diags, coupler_type_send_data -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : MOM_domain_type, domain2d, clone_MOM_domain, get_domain_extent use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE, TO_ALL, Omit_Corners @@ -171,8 +171,8 @@ module ocean_model_mod !! If false, the two phases are advanced with !! separate calls. The default is true. ! The following 3 variables are only used here if single_step_call is false. - real :: dt !< (baroclinic) dynamics time step [s] - real :: dt_therm !< thermodynamics time step [s] + real :: dt !< (baroclinic) dynamics time step [T ~> s] + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic @@ -293,16 +293,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that "//& - "is actually used will be an integer fraction of the "//& - "forcing time-step.", units="s", fail_if_missing=.true.) + "The (baroclinic) dynamics time step. The time-step that is actually "//& + "used will be an integer fraction of the forcing time-step.", & + units="s", scale=OS%US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & "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.", units="s", default=OS%dt) + "default DT_THERM is set to DT.", & + units="s", scale=OS%US%s_to_T, default=OS%US%T_to_s*OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -461,12 +462,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! internal modules. type(time_type) :: Time1 ! The value of the ocean model's time at the start of a call to step_MOM. integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocean boundary type. - real :: weight ! Flux accumulation weight of the current fluxes. - real :: dt_coupling ! The coupling time step [s]. - real :: dt_therm ! A limited and quantized version of OS%dt_therm [s]. - real :: dt_dyn ! The dynamics time step [s]. - real :: dtdia ! The diabatic time step [s]. - real :: t_elapsed_seg ! The elapsed time in this update segment [s]. + real :: weight ! Flux accumulation weight of the current fluxes [nondim]. + real :: dt_coupling ! The coupling time step [T ~> s]. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s]. + real :: dt_dyn ! The dynamics time step [T ~> s]. + real :: dtdia ! The diabatic time step [T ~> s]. + real :: t_elapsed_seg ! The elapsed time in this update segment [T ~> s]. integer :: n ! The internal iteration counter. integer :: nts ! The number of baroclinic dynamics time steps in a thermodynamic step. integer :: n_max ! The number of calls to step_MOM dynamics in this call to update_ocean_model. @@ -478,7 +479,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda integer :: is, ie, js, je call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") - dt_coupling = time_type_to_real(Ocean_coupling_time_step) + dt_coupling = OS%US%s_to_T*time_type_to_real(Ocean_coupling_time_step) if (.not.associated(OS)) then call MOM_error(FATAL, "update_ocean_model called with an unassociated "// & @@ -534,7 +535,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda OS%sfc_state, dt_coupling, OS%marine_ice_CSp) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, 1.0) ! Here weight=1, so just store the current fluxes call disable_averaging(OS%diag) #endif @@ -546,7 +547,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state) if (OS%use_ice_shelf) & - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time,dt_coupling, OS%Ice_shelf_CSp) if (OS%icebergs_alter_ocean) & call iceberg_fluxes(OS%grid, OS%US, OS%flux_tmp, OS%use_ice_shelf, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) @@ -582,10 +583,16 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) elseif ((.not.do_thermo) .or. (.not.do_dyn)) then ! The call sequence is being orchestrated from outside of update_ocean_model. - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + if (present(cycle_length)) then + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & - start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=cycle_length, & + start_cycle=start_cycle, end_cycle=end_cycle, cycle_length=OS%US%s_to_T*cycle_length, & reset_therm=Ocn_fluxes_used) + else + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=do_dyn, do_thermodynamics=do_thermo, & + start_cycle=start_cycle, end_cycle=end_cycle, reset_therm=Ocn_fluxes_used) + endif elseif (OS%single_step_call) then call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else ! Step both the dynamics and thermodynamics with separate calls. @@ -634,7 +641,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda if (step_thermo) then ! Back up Time1 to the start of the thermodynamic segment. - Time1 = Time1 - real_to_time(dtdia - dt_dyn) + Time1 = Time1 - real_to_time(OS%US%T_to_s*(dtdia - dt_dyn)) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) @@ -642,7 +649,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time1 = Time_seg_start + real_to_time(t_elapsed_seg) + Time1 = Time_seg_start + real_to_time(OS%US%T_to_s*t_elapsed_seg) enddo endif @@ -827,7 +834,6 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and ocean !! depth, usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1] ! Local variables - real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd integer :: i, j, i0, j0, is, ie, js, je @@ -982,7 +988,7 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. !! The data in OS is intent in. integer, intent(in) :: index !< The stock index for the quantity of interest. - real, intent(out) :: value !< Sum returned for the conservation quantity of interest. + real, intent(out) :: value !< Sum returned for the conservation quantity of interest [various] integer, optional, intent(in) :: time_index !< An unused optional argument, present only for !! interfacial compatibility with other models. ! Arguments: OS - A structure containing the internal ocean state. @@ -990,23 +996,23 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) ! (in) value - Sum returned for the conservation quantity of interest. ! (in,opt) time_index - Index for time level to use if this is necessary. - real :: salt + real :: salt ! The total salt in the ocean [kg] value = 0.0 if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return select case (index) - case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in kg. + case (ISTOCK_WATER) ! Return the mass of fresh water in the ocean in [kg]. if (OS%GV%Boussinesq) then call get_ocean_stocks(OS%MOM_CSp, mass=value, on_PE_only=.true.) else ! In non-Boussinesq mode, the mass of salt needs to be subtracted. call get_ocean_stocks(OS%MOM_CSp, mass=value, salt=salt, on_PE_only=.true.) value = value - salt endif - case (ISTOCK_HEAT) ! Return the heat content of the ocean in J. + case (ISTOCK_HEAT) ! Return the heat content of the ocean in [J]. call get_ocean_stocks(OS%MOM_CSp, heat=value, on_PE_only=.true.) - case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in kg. + case (ISTOCK_SALT) ! Return the mass of the salt in the ocean in [kg]. call get_ocean_stocks(OS%MOM_CSp, salt=value, on_PE_only=.true.) case default ; value = 0.0 end select @@ -1025,7 +1031,7 @@ subroutine ocean_model_data2D_get(OS, Ocean, name, array2D, isc, jsc) !! visible ocean surface fields. character(len=*) , intent(in) :: name !< The name of the field to extract real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must - !! cover only the computational domain + !! cover only the computational domain [various] integer , intent(in) :: isc !< The starting i-index of array2D integer , intent(in) :: jsc !< The starting j-index of array2D @@ -1085,8 +1091,8 @@ subroutine ocean_model_data1D_get(OS, Ocean, name, value) !! internal ocean state (intent in). type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly !! visible ocean surface fields. - character(len=*) , intent(in) :: name !< The name of the field to extract - real , intent(out):: value !< The value of the named field + character(len=*), intent(in) :: name !< The name of the field to extract + real, intent(out):: value !< The value of the named field [various] if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return @@ -1148,7 +1154,7 @@ subroutine ocean_model_get_UV_surf(OS, Ocean, name, array2D, isc, jsc) !! visible ocean surface fields. character(len=*) , intent(in) :: name !< The name of the current (ua or va) to extract real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must - !! cover only the computational domain + !! cover only the computational domain [L T-1 ~> m s-1] integer , intent(in) :: isc !< The starting i-index of array2D integer , intent(in) :: jsc !< The starting j-index of array2D diff --git a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 index 959e4676d0..8ea0867d03 100644 --- a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 @@ -25,8 +25,7 @@ program Shelf_main use MOM_cpu_clock, only : CLOCK_COMPONENT use MOM_debugging, only : MOM_debugging_init use MOM_diag_mediator, only : diag_mediator_init, diag_mediator_infrastructure_init - use MOM_diag_mediator, only : enable_averaging, disable_averaging, diag_mediator_end - use MOM_diag_mediator, only : diag_ctrl, diag_mediator_close_registration + use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration use MOM_domains, only : MOM_infra_init, MOM_infra_end use MOM_domains, only : MOM_domains_init, clone_MOM_domain, pass_var use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid @@ -96,13 +95,13 @@ program Shelf_main type(time_type) :: time_chg ! An amount of time to adjust the segment_start_time ! and elapsed time to avoid roundoff problems. - real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. + real :: elapsed_time = 0.0 ! Elapsed time in this run [T ~> s]. logical :: elapsed_time_master ! If true, elapsed time is used to set the ! model's master clock (Time). This is needed ! if Time_step_shelf is not an exact ! representation of time_step. - real :: time_step ! The time step [s] + real :: time_step ! The time step [T ~> s] ! A pointer to a structure containing metrics and related information. type(ocean_grid_type), pointer :: ocn_grid @@ -232,7 +231,7 @@ program Shelf_main call get_param(param_file, mod_name, "ICE_VELOCITY_TIMESTEP", time_step, & "The time step for changing forcing, coupling with other "//& "components, or potentially writing certain diagnostics.", & - units="s", fail_if_missing=.true.) + units="s", scale=US%s_to_T, fail_if_missing=.true.) if (sum(date) >= 0) then ! In this case, the segment starts at a time fixed by ocean_solo.res @@ -282,8 +281,8 @@ program Shelf_main segment_start_time = Time elapsed_time = 0.0 - Time_step_shelf = real_to_time(time_step) - elapsed_time_master = (abs(time_step - time_type_to_real(Time_step_shelf)) > 1.0e-12*time_step) + Time_step_shelf = real_to_time(US%T_to_s*time_step) + elapsed_time_master = (abs(time_step - US%s_to_T*time_type_to_real(Time_step_shelf)) > 1.0e-12*time_step) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) @@ -384,18 +383,18 @@ program Shelf_main ! Time = Time + Time_step_shelf ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + time_step - if (elapsed_time > 2e9) then + if (elapsed_time > 2.0e9*US%s_to_T) then ! This is here to ensure that the conversion from a real to an integer can be accurately ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time ! does not lose resolution of order the timetype's resolution, provided that the timestep and ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller ! value would be required. - time_chg = real_to_time(elapsed_time) + time_chg = real_to_time(US%T_to_s*elapsed_time) segment_start_time = segment_start_time + time_chg - elapsed_time = elapsed_time - time_type_to_real(time_chg) + elapsed_time = elapsed_time - US%s_to_T*time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + real_to_time(elapsed_time) + Master_Time = segment_start_time + real_to_time(US%T_to_s*elapsed_time) else Master_Time = Master_Time + Time_step_shelf endif 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 c2ee910dbb..1a15760d00 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -17,7 +17,7 @@ module MOM_ocean_model_mct use MOM, only : get_ocean_stocks, step_offline use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners @@ -170,8 +170,8 @@ module MOM_ocean_model_mct !! If false, the two phases are advanced with !! separate calls. The default is true. ! The following 3 variables are only used here if single_step_call is false. - real :: dt !< (baroclinic) dynamics time step (seconds) - real :: dt_therm !< thermodynamics time step (seconds) + real :: dt !< (baroclinic) dynamics time step [T ~> s] + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic @@ -285,16 +285,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that "//& - "is actually used will be an integer fraction of the "//& - "forcing time-step.", units="s", fail_if_missing=.true.) + "The (baroclinic) dynamics time step. The time-step that is actually "//& + "used will be an integer fraction of the forcing time-step.", & + units="s", scale=OS%US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & "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.", units="s", default=OS%dt) + "default DT_THERM is set to DT.", & + units="s", scale=OS%US%s_to_T, default=OS%US%T_to_s*OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -448,13 +449,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: index_bnds(4) ! The computational domain index bounds in the ! ice-ocean boundary type. real :: weight ! Flux accumulation weight - real :: dt_coupling ! The coupling time step in seconds. + real :: dt_coupling ! The coupling time step [T ~> s] integer :: nts ! The number of baroclinic dynamics time steps ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s] + real :: dt_dyn ! The dynamics time step [T ~> s] + real :: dtdia ! The diabatic time step [T ~> s] + real :: t_elapsed_seg ! The elapsed time in this update segment [T ~> s] integer :: n, n_max, n_last_thermo type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans @@ -467,7 +468,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call callTree_enter("update_ocean_model(), MOM_ocean_model_mct.F90") call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) + dt_coupling = OS%US%s_to_T*(86400.0*real(days) + real(secs)) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -501,7 +502,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then ! GMM, is enable_averaging needed now? - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, dt_coupling, & @@ -528,7 +529,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes #endif @@ -639,7 +640,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - set_time(int(floor(OS%US%T_to_s*(dtdia - dt_dyn) + 0.5))) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) @@ -647,7 +648,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + set_time(int(floor(OS%US%T_to_s*t_elapsed_seg + 0.5))) enddo endif diff --git a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 index 259aa8a678..0364d46ddc 100644 --- a/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/mct_cap/mom_surface_forcing_mct.F90 @@ -76,14 +76,14 @@ module MOM_surface_forcing_mct !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the !! bottom boundary layer by drag on the tidal flows [R Z3 T-3 ~> W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar [R L Z T-1 ~> Pa]. + !! gustiness that contributes to ustar [R L Z T-2 ~> Pa]. !! gust is used when read_gust_2d is true. ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) @@ -206,7 +206,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. real, intent(in) :: valid_time !< The amount of time over which these fluxes - !! should be applied [s]. + !! should be applied [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a @@ -334,7 +334,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Indicate that there are new unused fluxes. fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*valid_time + fluxes%dt_buoy_accum = valid_time if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:) = 0.0 @@ -444,7 +444,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, end if if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -1119,7 +1119,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & "A factor multiplying the wind-stress given to the ocean by the "//& "coupler. This is used for testing and should be =1.0 for any "//& - "production runs.", default=1.0) + "production runs.", units="nondim", default=1.0) if (restore_salt) then call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & 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 9c81a67202..04b60b0d37 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -17,7 +17,7 @@ module MOM_ocean_model_nuopc use MOM, only : get_ocean_stocks, step_offline use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf -use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging +use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners @@ -171,7 +171,7 @@ module MOM_ocean_model_nuopc !! separate calls. The default is true. ! The following 3 variables are only used here if single_step_call is false. real :: dt !< (baroclinic) dynamics time step (seconds) - real :: dt_therm !< thermodynamics time step (seconds) + real :: dt_therm !< thermodynamics time step [T ~> s] logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic @@ -298,16 +298,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that "//& - "is actually used will be an integer fraction of the "//& - "forcing time-step.", units="s", fail_if_missing=.true.) + "The (baroclinic) dynamics time step. The time-step that is actually "//& + "used will be an integer fraction of the forcing time-step.", & + units="s", scale=OS%US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & "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.", units="s", default=OS%dt) + "default DT_THERM is set to DT.", & + units="s", default=OS%US%T_to_s*OS%dt, scale=OS%US%s_to_T) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & "If true, the MOM will take thermodynamic and tracer "//& "timesteps that can be longer than the coupling timestep. "//& @@ -490,13 +491,13 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: index_bnds(4) ! The computational domain index bounds in the ! ice-ocean boundary type. real :: weight ! Flux accumulation weight - real :: dt_coupling ! The coupling time step in seconds. + real :: dt_coupling ! The coupling time step in rescaled seconds [T ~> s]. integer :: nts ! The number of baroclinic dynamics time steps ! within dt_coupling. - real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) - real :: dt_dyn ! The dynamics time step in sec. - real :: dtdia ! The diabatic time step in sec. - real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + real :: dt_therm ! A limited and quantized version of OS%dt_therm [T ~> s] + real :: dt_dyn ! The dynamics time step [T ~> s] + real :: dtdia ! The diabatic time step [T ~> s] + real :: t_elapsed_seg ! The elapsed time in this update segment [T ~> s] integer :: n, n_max, n_last_thermo type(time_type) :: Time2 ! A temporary time. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans @@ -509,7 +510,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call callTree_enter("update_ocean_model(), MOM_ocean_model_nuopc.F90") call get_time(Ocean_coupling_time_step, secs, days) - dt_coupling = 86400.0*real(days) + real(secs) + dt_coupling = OS%US%s_to_T*(86400.0*real(days) + real(secs)) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -565,14 +566,14 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid, skip_pres=.true.) #ifdef _USE_GENERIC_TRACER - call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes #endif else OS%flux_tmp%C_p = OS%fluxes%C_p if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, dt_coupling, & - OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity, OS%restore_temp) if (OS%use_ice_shelf) then if (do_thermo) & @@ -677,7 +678,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (step_thermo) then ! Back up Time2 to the start of the thermodynamic segment. - Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + Time2 = Time2 - set_time(int(floor(OS%US%T_to_s*(dtdia - dt_dyn) + 0.5))) call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) @@ -685,7 +686,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + Time2 = Time1 + set_time(int(floor(OS%US%T_to_s*t_elapsed_seg + 0.5))) enddo endif diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index 30c54e6c4f..b921f7355d 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -80,14 +80,14 @@ module MOM_surface_forcing_nuopc logical :: use_CFC !< enables the MOM_CFC_cap tracer package. logical :: enthalpy_cpl !< Controls if enthalpy terms are provided by the coupler or computed !! internally. - real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the !! bottom boundary layer by drag on the tidal flows [R Z3 T-3 ~> W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar [R L Z T-1 ~> Pa]. + !! gustiness that contributes to ustar [R L Z T-2 ~> Pa]. !! gust is used when read_gust_2d is true. ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [Z T-1 ~> m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) @@ -227,7 +227,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. real, intent(in) :: valid_time !< The amount of time over which these fluxes - !! should be applied [s]. + !! should be applied [T ~> s]. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a @@ -355,7 +355,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Indicate that there are new unused fluxes. fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*valid_time + fluxes%dt_buoy_accum = valid_time if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 @@ -1195,7 +1195,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & "A factor multiplying the wind-stress given to the ocean by the "//& "coupler. This is used for testing and should be =1.0 for any "//& - "production runs.", default=1.0) + "production runs.", units="nondim", default=1.0) call get_param(param_file, mdl, "USE_CFC_CAP", CS%use_CFC, & default=.false., do_not_log=.true.) diff --git a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 index 18c3c33fdb..12f1b6b78d 100644 --- a/config_src/drivers/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MESO_surface_forcing.F90 @@ -31,7 +31,7 @@ module MESO_surface_forcing real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [R L Z T-1 ~> Pa] + !! that contributes to ustar [R L Z T-2 ~> Pa] real, dimension(:,:), pointer :: & T_Restore(:,:) => NULL(), & !< The temperature to restore the SST toward [C ~> degC]. S_Restore(:,:) => NULL(), & !< The salinity to restore the sea surface salnity toward [S ~> ppt] diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 1d603740a1..974843c10f 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -27,8 +27,7 @@ program MOM6 use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT use MOM_data_override, only : data_override_init - use MOM_diag_mediator, only : enable_averaging, disable_averaging, diag_mediator_end - use MOM_diag_mediator, only : diag_ctrl, diag_mediator_close_registration + use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized @@ -122,20 +121,18 @@ program MOM6 type(time_type) :: Time_step_ocean ! A time_type version of dt_forcing. logical :: segment_start_time_set ! True if segment_start_time has been set to a valid value. - real :: elapsed_time = 0.0 ! Elapsed time in this run [s]. - logical :: elapsed_time_master ! If true, elapsed time is used to set the - ! model's master clock (Time). This is needed - ! if Time_step_ocean is not an exact - ! representation of dt_forcing. - real :: dt_forcing ! The coupling time step [s]. - real :: dt ! The nominal baroclinic dynamics time step [s]. - integer :: ntstep ! The number of baroclinic dynamics time steps - ! within dt_forcing. - real :: dt_therm ! The thermodynamic timestep [s] - real :: dt_dyn ! The actual dynamic timestep used [s]. The value of dt_dyn is - ! chosen so that dt_forcing is an integer multiple of dt_dyn. - real :: dtdia ! The diabatic timestep [s] - real :: t_elapsed_seg ! The elapsed time in this run segment [s] + real :: elapsed_time = 0.0 ! Elapsed time in this run [T ~> s]. + logical :: elapsed_time_master ! If true, elapsed time is used to set the model's master + ! clock (Time). This is needed if Time_step_ocean is not + ! an exact representation of dt_forcing. + real :: dt_forcing ! The coupling time step [T ~> s]. + real :: dt ! The nominal baroclinic dynamics time step [T ~> s]. + integer :: ntstep ! The number of baroclinic dynamics time steps within dt_forcing. + real :: dt_therm ! The thermodynamic timestep [T ~> s] + real :: dt_dyn ! The actual dynamic timestep used [T ~> s]. The value of dt_dyn + ! is chosen so that dt_forcing is an integer multiple of dt_dyn. + real :: dtdia ! The diabatic timestep [T ~> s] + real :: t_elapsed_seg ! The elapsed time in this run segment [T ~> s] integer :: n, ns, n_max, nts, n_last_thermo logical :: diabatic_first, single_step_call type(time_type) :: Time2, time_chg ! Temporary time variables @@ -331,25 +328,28 @@ program MOM6 ! Read all relevant parameters and write them to the model log. call log_version(param_file, mod_name, version, "") - call get_param(param_file, mod_name, "DT", dt, fail_if_missing=.true.) + call get_param(param_file, mod_name, "DT", dt, & + units="s", scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mod_name, "DT_FORCING", dt_forcing, & "The time step for changing forcing, coupling with other "//& "components, or potentially writing certain diagnostics. "//& - "The default value is given by DT.", units="s", default=dt) + "The default value is given by DT.", & + units="s", default=US%T_to_s*dt, scale=US%s_to_T) if (offline_tracer_mode) then call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & "Length of time between reading in of input fields", & - units='s', fail_if_missing=.true.) + units="s", scale=US%s_to_T, fail_if_missing=.true.) dt = dt_forcing endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) - Time_step_ocean = real_to_time(dt_forcing) - elapsed_time_master = (abs(dt_forcing - time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) + Time_step_ocean = real_to_time(US%T_to_s*dt_forcing) + elapsed_time_master = (abs(dt_forcing - US%s_to_T*time_type_to_real(Time_step_ocean)) > 1.0e-12*dt_forcing) if (elapsed_time_master) & call MOM_mesg("Using real elapsed time for the master clock.", 2) ! Determine the segment end time, either from the namelist file or parsed input file. + ! Note that Time_unit always is in [s]. call get_param(param_file, mod_name, "TIMEUNIT", Time_unit, & "The time unit for DAYMAX, ENERGYSAVEDAYS, and RESTINT.", & units="s", default=86400.0) @@ -384,7 +384,8 @@ program MOM6 "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.", units="s", default=dt) + "default DT_THERM is set to DT.", & + units="s", default=US%T_to_s*dt, scale=US%s_to_T) call get_param(param_file, mod_name, "DIABATIC_FIRST", diabatic_first, & "If true, apply diabatic and thermodynamic processes, "//& "including buoyancy forcing and mass gain or loss, "//& @@ -465,7 +466,7 @@ program MOM6 call add_shelf_forces(grid, US, Ice_shelf_CSp, forces, external_call=.true.) endif fluxes%fluxes_used = .false. - fluxes%dt_buoy_accum = US%s_to_T*dt_forcing + fluxes%dt_buoy_accum = dt_forcing if (use_waves) then call Update_Surface_Waves(grid, GV, US, time, time_step_ocean, waves_csp) @@ -510,7 +511,7 @@ program MOM6 dtdia = dt_dyn*(n - n_last_thermo) ! Back up Time2 to the start of the thermodynamic segment. if (n > n_last_thermo+1) & - Time2 = Time2 - real_to_time(dtdia - dt_dyn) + Time2 = Time2 - real_to_time(US%T_to_s*(dtdia - dt_dyn)) call step_MOM(forces, fluxes, sfc_state, Time2, dtdia, MOM_CSp, & do_dynamics=.false., do_thermodynamics=.true., & start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_forcing) @@ -519,25 +520,25 @@ program MOM6 endif t_elapsed_seg = t_elapsed_seg + dt_dyn - Time2 = Time1 + real_to_time(t_elapsed_seg) + Time2 = Time1 + real_to_time(US%T_to_s*t_elapsed_seg) enddo endif ! Time = Time + Time_step_ocean ! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + dt_forcing - if (elapsed_time > 2e9) then + if (elapsed_time > 2.0e9*US%s_to_T) then ! This is here to ensure that the conversion from a real to an integer can be accurately ! represented in long runs (longer than ~63 years). It will also ensure that elapsed time ! does not lose resolution of order the timetype's resolution, provided that the timestep and ! tick are larger than 10-5 seconds. If a clock with a finer resolution is used, a smaller ! value would be required. - time_chg = real_to_time(elapsed_time) + time_chg = real_to_time(US%T_to_s*elapsed_time) segment_start_time = segment_start_time + time_chg - elapsed_time = elapsed_time - time_type_to_real(time_chg) + elapsed_time = elapsed_time - US%s_to_T*time_type_to_real(time_chg) endif if (elapsed_time_master) then - Master_Time = segment_start_time + real_to_time(elapsed_time) + Master_Time = segment_start_time + real_to_time(US%T_to_s*elapsed_time) else Master_Time = Master_Time + Time_step_ocean endif diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 1d72dc8eb6..522420e004 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -30,6 +30,7 @@ module MOM_surface_forcing use MOM_grid, only : ocean_grid_type use MOM_get_input, only : Get_MOM_Input, directories use MOM_io, only : file_exists, MOM_read_data, MOM_read_vector, slasher +use MOM_io, only : read_netCDF_data use MOM_io, only : EAST_FACE, NORTH_FACE, num_timelevels use MOM_restart, only : register_restart_field, restart_init, MOM_restart_CS use MOM_restart, only : restart_init_end, save_restart, restore_state @@ -73,8 +74,8 @@ module MOM_surface_forcing logical :: adiabatic !< if true, no diapycnal mass fluxes or surface buoyancy forcing logical :: variable_winds !< if true, wind stresses vary with time logical :: variable_buoyforce !< if true, buoyancy forcing varies with time. - real :: south_lat !< southern latitude of the domain - real :: len_lat !< domain length in latitude + real :: south_lat !< southern latitude of the domain [degrees_N] or [km] or [m] + real :: len_lat !< domain length in latitude [degrees_N] or [km] or [m] real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] real :: G_Earth !< gravitational acceleration [L2 Z-1 T-2 ~> m s-2] @@ -84,13 +85,13 @@ module MOM_surface_forcing real :: latent_heat_fusion !< latent heat of fusion times [Q ~> J kg-1] real :: latent_heat_vapor !< latent heat of vaporization [Q ~> J kg-1] real :: tau_x0 !< Constant zonal wind stress used in the WIND_CONFIG="const" - !! forcing [R L Z T-1 ~> Pa] + !! forcing [R L Z T-2 ~> Pa] real :: tau_y0 !< Constant meridional wind stress used in the WIND_CONFIG="const" - !! forcing [R L Z T-1 ~> Pa] + !! forcing [R L Z T-2 ~> Pa] - real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa] + real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] logical :: read_gust_2d !< if true, use 2-dimensional gustiness supplied from a file - real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [R L Z T-1 ~> Pa] + real, pointer :: gust(:,:) => NULL() !< spatially varying unresolved background gustiness [R L Z T-2 ~> Pa] !! gust is used when read_gust_2d is true. real, pointer :: T_Restore(:,:) => NULL() !< temperature to damp (restore) the SST to [C ~> degC] @@ -101,10 +102,10 @@ module MOM_surface_forcing ! if WIND_CONFIG=='gyres' then use the following as = A, B, C and n respectively for ! taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L) - real :: gyres_taux_const !< A constant wind stress [R L Z T-1 ~> Pa]. - real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' - real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' - real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' + real :: gyres_taux_const !< A constant wind stress [R L Z T-2 ~> Pa]. + real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [R L Z T-2 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-2 ~> Pa], if WIND_CONFIG=='gyres' + real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' [nondim] integer :: answer_date !< This 8-digit integer gives the approximate date with which the order !! of arithmetic and expressions were added to the code. !! Dates before 20190101 use original answers. @@ -114,7 +115,7 @@ module MOM_surface_forcing !! gustless wind friction velocity. ! if WIND_CONFIG=='scurves' then use the following to define a piecewise scurve profile real :: scurves_ydata(20) = 90. !< Latitudes of scurve nodes [degreesN] - real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-1 ~> Pa] + real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-2 ~> Pa] real :: T_north !< Target temperatures at north used in buoyancy_forcing_linear [C ~> degC] real :: T_south !< Target temperatures at south used in buoyancy_forcing_linear [C ~> degC] @@ -392,7 +393,7 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) mag_tau = sqrt( tau_x0**2 + tau_y0**2) - ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. + ! Set the steady surface wind stresses, in units of [R L Z T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq forces%taux(I,j) = tau_x0 enddo ; enddo @@ -438,7 +439,7 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) Pa_to_RLZ_T2 = US%kg_m3_to_R*US%m_s_to_L_T**2*US%L_to_Z PI = 4.0*atan(1.0) - ! Set the steady surface wind stresses, in units of [R L Z T-1 ~> Pa]. + ! Set the steady surface wind stresses, in units of [R L Z T-2 ~> Pa]. do j=js,je ; do I=is-1,Ieq forces%taux(I,j) = 0.1 * Pa_to_RLZ_T2 * & (1.0 - cos(2.0*PI*(G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat)) @@ -513,7 +514,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) - ! steady surface wind stresses [R L Z T-1 ~> Pa] + ! steady surface wind stresses [R L Z T-2 ~> Pa] do j=js-1,je+1 ; do I=is-1,Ieq y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & @@ -670,8 +671,8 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables character(len=200) :: filename ! The name of the input file. - real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-1 ~> Pa] - real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-1 ~> Pa] + real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal wind stresses at h-points [R L Z T-2 ~> Pa] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional wind stresses at h-points [R L Z T-2 ~> Pa] real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units ! for wind stresses [R Z L T-2 Pa-1 ~> 1] integer :: time_lev_daily ! The time levels to read for fields with @@ -1301,7 +1302,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, US !#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) !#CTRL# enddo ; enddo !#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!#CTRL# fluxes%vprec, day, US%T_to_s*dt, G, US, CS%ctrl_forcing_CSp) +!#CTRL# fluxes%vprec, day, dt, G, US, CS%ctrl_forcing_CSp) !#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") @@ -1729,7 +1730,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "USTAR_FORCING_VAR", CS%ustar_var, & "The name of the friction velocity variable in WIND_FILE "//& "or blank to get ustar from the wind stresses plus the "//& - "gustiness.", default=" ", units="nondim") + "gustiness.", default=" ") CS%wind_file = trim(CS%inputdir) // trim(CS%wind_file) endif if (trim(CS%wind_config) == "gyres") then @@ -1802,9 +1803,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & - "If true, the buoyancy fluxes drive the model back "//& - "toward some specified surface state with a rate "//& - "given by FLUXCONST.", default= .false.) + "If true, the buoyancy fluxes drive the model back toward some "//& + "specified surface state with a rate given by FLUXCONST.", default=.false.) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", default=hlf, & units="J/kg", scale=US%J_kg_to_Q) @@ -1815,22 +1815,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes to the relative "//& "surface anomalies (akin to a piston velocity). Note the non-MKS units.", & - default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & - unscaled=flux_const_default) + default=0.0, units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0) if (CS%use_temperature) then + call get_param(param_file, mdl, "FLUXCONST", flux_const_default, & + default=0.0, units="m day-1", do_not_log=.true.) call get_param(param_file, mdl, "FLUXCONST_T", CS%Flux_const_T, & - "The constant that relates the restoring surface temperature "//& - "flux to the relative surface anomaly (akin to a piston "//& - "velocity). Note the non-MKS units.", & - units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & - default=flux_const_default) + "The constant that relates the restoring surface temperature flux to the "//& + "relative surface anomaly (akin to a piston velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, default=flux_const_default) call get_param(param_file, mdl, "FLUXCONST_S", CS%Flux_const_S, & - "The constant that relates the restoring surface salinity "//& - "flux to the relative surface anomaly (akin to a piston "//& - "velocity). Note the non-MKS units.", & - units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, & - default=flux_const_default) + "The constant that relates the restoring surface salinity flux to the "//& + "relative surface anomaly (akin to a piston velocity). Note the non-MKS units.", & + units="m day-1", scale=US%m_to_Z*US%T_to_s/86400.0, default=flux_const_default) endif if (trim(CS%buoy_config) == "linear") then @@ -1854,7 +1851,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) + units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", & @@ -1871,8 +1868,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) filename = trim(CS%inputdir) // trim(gust_file) - call MOM_read_data(filename,'gustiness',CS%gust,G%domain, timelevel=1, & - scale=Pa_to_RLZ_T2) ! units in file should be Pa + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(filename, 'gustiness', CS%gust, G%Domain, & + rescale=Pa_to_RLZ_T2) ! units in file should be Pa endif ! All parameter settings are now known. diff --git a/config_src/drivers/solo_driver/user_surface_forcing.F90 b/config_src/drivers/solo_driver/user_surface_forcing.F90 index ae3f854335..fc803c27e6 100644 --- a/config_src/drivers/solo_driver/user_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/user_surface_forcing.F90 @@ -33,10 +33,10 @@ module user_surface_forcing logical :: use_temperature !< If true, temperature and salinity are used as state variables. logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. real :: Rho0 !< The density used in the Boussinesq approximation [R ~> kg m-3]. - real :: G_Earth !< The gravitational acceleration [L2 Z-1 s-2 ~> m s-2]. + real :: G_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: gust_const !< A constant unresolved background gustiness - !! that contributes to ustar [R L Z T-1 ~> Pa]. + !! that contributes to ustar [R L Z T-2 ~> Pa]. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. @@ -71,7 +71,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) - ! Set the surface wind stresses, in units of [R L Z T-1 ~> Pa]. A positive taux + ! Set the surface wind stresses, in units of [R L Z T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index f962719d93..7a1ba82843 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -51,7 +51,7 @@ program MOM_sum_driver logical :: unit_in_use real, allocatable, dimension(:) :: & - depth_tot_R, depth_tot_std, depth_tot_fastR + depth_tot_R, depth_tot_std, depth_tot_fastR ! Various sums of the depths [m] integer :: reproClock, fastreproClock, stdClock, initClock !----------------------------------------------------------------------- @@ -175,16 +175,17 @@ program MOM_sum_driver subroutine benchmark_init_topog_local(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth in [m] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters real, intent(in) :: max_depth !< The maximum ocean depth [m] - real :: min_depth ! The minimum ocean depth in m. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: D0 ! A constant to make the maximum ! - ! basin depth MAXIMUM_DEPTH. ! - real :: m_to_Z ! A dimensional rescaling factor. - real :: x, y + real :: min_depth ! The minimum ocean depth in [m]. + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] + real :: D0 ! A constant to make the maximum + ! basin depth MAXIMUM_DEPTH [m] + real :: m_to_Z ! A dimensional rescaling factor [Z m-1 ~> 1] + real :: x ! A fractional position in the x-direction [nondim] + real :: y ! A fractional position in the y-direction [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "benchmark_init_topog_local" ! This subroutine's name. @@ -203,8 +204,8 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) ! Calculate the depth of the bottom. do i=is,ie ; do j=js,je - x=(G%geoLonT(i,j)-G%west_lon)/G%len_lon - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat + x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon + y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat ! This sets topography that has a reentrant channel to the south. D(i,j) = -D0 * ( y*(1.0 + 0.6*cos(4.0*PI*x)) & + 0.75*exp(-6.0*y) & diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 index cbc310eb7d..ea9f225a27 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer_utils.F90 @@ -25,7 +25,10 @@ module g_tracer_utils character(len=fm_string_len) :: src_var_name !< Tracer source variable name character(len=fm_string_len) :: src_var_unit !< Tracer source variable units character(len=fm_string_len) :: src_var_gridspec !< Tracer source grid file name + character(len=fm_string_len) :: obc_src_file_name !< Boundary condition tracer source filename + character(len=fm_string_len) :: obc_src_field_name !< Boundary condition tracer source fieldname integer :: src_var_record !< Unknown + logical :: runoff_added_to_stf = .false. !< Has flux in from runoff been added to stf? logical :: requires_src_info = .false. !< Unknown real :: src_var_unit_conversion = 1.0 !< This factor depends on the tracer. Ask Jasmin real :: src_var_valid_min = 0.0 !< Unknown @@ -61,6 +64,7 @@ module g_tracer_utils public :: g_tracer_get_next public :: g_tracer_is_prog public :: g_diag_type + public :: g_tracer_get_obc_segment_props !> Set the values of various (array) members of the tracer node g_tracer_type !! @@ -284,6 +288,17 @@ subroutine g_tracer_get_next(g_tracer,g_tracer_next) type(g_tracer_type), pointer :: g_tracer_next !< Pointer to the next tracer node in the list end subroutine g_tracer_get_next + !> get obc segment properties for each tracer + subroutine g_tracer_get_obc_segment_props(g_tracer_list, name, obc_has, src_file, src_var_name,lfac_in,lfac_out) + type(g_tracer_type), pointer :: g_tracer_list !< pointer to the head of the generic tracer list + character(len=*), intent(in) :: name !< tracer name + logical, intent(out):: obc_has !< .true. if This tracer has OBC + real, optional,intent(out):: lfac_in !< OBC reservoir inverse lengthscale factor + real, optional,intent(out):: lfac_out !< OBC reservoir inverse lengthscale factor + character(len=*),optional,intent(out):: src_file !< OBC source file + character(len=*),optional,intent(out):: src_var_name !< OBC source variable in file + end subroutine g_tracer_get_obc_segment_props + !>Vertical Diffusion of a tracer node !! !! This subroutine solves a tridiagonal equation to find and set values of vertically diffused field diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index dc8a9af3d5..54b9dfb78b 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -509,8 +509,8 @@ subroutine open_ASCII_file(unit, file, action, threading, fileset) ! This checks if open() failed but did not raise a runtime error. inquire(unit, opened=is_open) if (.not. is_open) & - call MOM_error(FATAL, 'open_ASCII_file: File ' // trim(filename) // & - ' failed to open.') + call MOM_error(FATAL, & + 'open_ASCII_file: File "' // trim(filename) // '" failed to open.') ! NOTE: There are two possible mpp_write_meta functions in FMS1: ! - call mpp_write_meta( unit, 'filename', cval=mpp_file(unit)%name) @@ -1680,13 +1680,16 @@ subroutine categorize_axes(fileObj, filename, ndims, dim_names, is_x, is_y, is_t ! First look for indicative variable attributes if (.not.is_t(i)) then if (variable_exists(fileobj, trim(dim_names(i)))) then + cartesian = "" if (variable_att_exists(fileobj, trim(dim_names(i)), "cartesian_axis")) then call get_variable_attribute(fileobj, trim(dim_names(i)), "cartesian_axis", cartesian) - cartesian = adjustl(cartesian) - if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. - if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. - if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. + elseif (variable_att_exists(fileobj, trim(dim_names(i)), "axis")) then + call get_variable_attribute(fileobj, trim(dim_names(i)), "axis", cartesian) endif + cartesian = adjustl(cartesian) + if ((index(cartesian, "X") == 1) .or. (index(cartesian, "x") == 1)) is_x(i) = .true. + if ((index(cartesian, "Y") == 1) .or. (index(cartesian, "y") == 1)) is_y(i) = .true. + if ((index(cartesian, "T") == 1) .or. (index(cartesian, "t") == 1)) is_t(i) = .true. endif endif if (is_x(i)) x_found = .true. diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 8116ba3e17..137f6cee9b 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -13,7 +13,6 @@ module MOM_ALE use MOM_debugging, only : check_column_integrals use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl use MOM_diag_mediator, only : time_type, diag_update_remap_grids, query_averaging_enabled -use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_error_handler, only : callTree_showQuery @@ -40,6 +39,7 @@ module MOM_ALE use MOM_remapping, only : initialize_remapping, end_remapping use MOM_remapping, only : remapping_core_h, remapping_core_w use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme +use MOM_remapping, only : interpolate_column, reintegrate_column use MOM_remapping, only : remapping_CS, dzFromH1H2 use MOM_string_functions, only : uppercase, extractWord, extract_integer use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chkinv @@ -129,6 +129,8 @@ module MOM_ALE public ALE_remap_scalar public ALE_remap_tracers public ALE_remap_velocities +public ALE_remap_interface_vals +public ALE_remap_vertex_vals public ALE_PLM_edge_values public TS_PLM_edge_values public TS_PPM_edge_values @@ -204,12 +206,12 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call get_param(param_file, mdl, "REMAPPING_SCHEME", string, & "This sets the reconstruction scheme used "//& "for vertical remapping for all variables. "//& - "It can be one of the following schemes: "//& + "It can be one of the following schemes: \n"//& trim(remappingSchemesDoc), default=remappingDefaultScheme) call get_param(param_file, mdl, "VELOCITY_REMAPPING_SCHEME", vel_string, & "This sets the reconstruction scheme used for vertical remapping "//& "of velocities. By default it is the same as REMAPPING_SCHEME. "//& - "It can be one of the following schemes: "//& + "It can be one of the following schemes: \n"//& trim(remappingSchemesDoc), default=trim(string)) call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & "If true, cell-by-cell reconstructions are checked for "//& @@ -289,10 +291,10 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth, & depth_of_time_filter_deep=filter_deep_depth) call get_param(param_file, mdl, "REGRID_USE_OLD_DIRECTION", local_logical, & - "If true, the regridding ntegrates upwards from the bottom for "//& + "If true, the regridding integrates upwards from the bottom for "//& "interface positions, much as the main model does. If false "//& - "regridding integrates downward, consistant with the remapping "//& - "code.", default=.true., do_not_log=.true.) + "regridding integrates downward, consistent with the remapping code.", & + default=.true., do_not_log=.true.) call set_regrid_params(CS%regridCS, integrate_downward_for_e=.not.local_logical) call get_param(param_file, mdl, "REMAP_VEL_MASK_BBL_THICK", CS%BBL_h_vel_mask, & @@ -536,7 +538,7 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) if (G%mask2dCu(i,j)>0.) then h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:)) h_dest(:) = 0.5 * (h_new(i,j,:) + h_new(i+1,j,:)) - call reintegrate_column(nk, h_src, uhtr(I,j,:), nk, h_dest, 0., temp_vec) + call reintegrate_column(nk, h_src, uhtr(I,j,:), nk, h_dest, temp_vec) uhtr(I,j,:) = temp_vec endif enddo ; enddo @@ -544,17 +546,17 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) if (G%mask2dCv(i,j)>0.) then h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:)) h_dest(:) = 0.5 * (h_new(i,j,:) + h_new(i,j+1,:)) - call reintegrate_column(nk, h_src, vhtr(I,j,:), nk, h_dest, 0., temp_vec) + call reintegrate_column(nk, h_src, vhtr(I,j,:), nk, h_dest, temp_vec) vhtr(I,j,:) = temp_vec endif enddo ; enddo - do j = jsc,jec ; do i=isc,iec + do j=jsc,jec ; do i=isc,iec if (G%mask2dT(i,j)>0.) then if (check_column_integrals(nk, h_src, nk, h_dest)) then call MOM_error(FATAL, "ALE_offline_inputs: Kd interpolation columns do not match") endif - call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), 0., Kd(i,j,:)) + call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), Kd(i,j,:), .true.) endif enddo ; enddo @@ -974,6 +976,89 @@ subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface, end subroutine ALE_remap_velocities +!> Interpolate to find an updated array of values at interfaces after remapping. +subroutine ALE_remap_interface_vals(CS, G, GV, h_old, h_new, int_val) + type(ALE_CS), intent(in) :: CS !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + intent(inout) :: int_val !< The interface values to interpolate [A] + + real :: val_src(GV%ke+1) ! A column of interface values on the source grid [A] + real :: val_tgt(GV%ke+1) ! A column of interface values on the target grid [A] + real :: h_src(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h_tgt(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + integer :: i, j, k, nz + + nz = GV%ke + + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (G%mask2dT(i,j)>0.) then + do k=1,nz + h_src(k) = h_old(i,j,k) + h_tgt(k) = h_new(i,j,k) + enddo + + do K=1,nz+1 + val_src(K) = int_val(i,j,K) + enddo + + call interpolate_column(nz, h_src, val_src, nz, h_tgt, val_tgt, .false.) + + do K=1,nz+1 + int_val(i,j,K) = val_tgt(K) + enddo + endif ; enddo ; enddo + +end subroutine ALE_remap_interface_vals + +!> Interpolate to find an updated array of values at vertices of tracer cells after remapping. +subroutine ALE_remap_vertex_vals(CS, G, GV, h_old, h_new, vert_val) + type(ALE_CS), intent(in) :: CS !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid + !! [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & + intent(inout) :: vert_val !< The interface values to interpolate [A] + + real :: val_src(GV%ke+1) ! A column of interface values on the source grid [A] + real :: val_tgt(GV%ke+1) ! A column of interface values on the target grid [A] + real :: h_src(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h_tgt(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + real :: I_mask_sum ! The inverse of the tracer point masks surrounding a corner [nondim] + integer :: i, j, k, nz + + nz = GV%ke + + do J=G%JscB,G%JecB ; do I=G%IscB,G%IecB + if ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + (G%mask2dT(i+1,j) + G%mask2dT(i,j+1)) > 0.0 ) then + I_mask_sum = 1.0 / ((G%mask2dT(i,j) + G%mask2dT(i+1,j+1)) + (G%mask2dT(i+1,j) + G%mask2dT(i,j+1))) + + do k=1,nz + h_src(k) = ((G%mask2dT(i,j) * h_old(i,j,k) + G%mask2dT(i+1,j+1) * h_old(i+1,j+1,k)) + & + (G%mask2dT(i+1,j) * h_old(i+1,j,k) + G%mask2dT(i,j+1) * h_old(i,j+1,k)) ) * I_mask_sum + h_tgt(k) = ((G%mask2dT(i,j) * h_new(i,j,k) + G%mask2dT(i+1,j+1) * h_new(i+1,j+1,k)) + & + (G%mask2dT(i+1,j) * h_new(i+1,j,k) + G%mask2dT(i,j+1) * h_new(i,j+1,k)) ) * I_mask_sum + enddo + + do K=1,nz+1 + val_src(K) = vert_val(I,J,K) + enddo + + call interpolate_column(nz, h_src, val_src, nz, h_tgt, val_tgt, .false.) + + do K=1,nz+1 + vert_val(I,J,K) = val_tgt(K) + enddo + endif ; enddo ; enddo + +end subroutine ALE_remap_vertex_vals !> Mask out thicknesses to 0 when their running sum exceeds a specified value. subroutine apply_partial_cell_mask(h1, h_mask) diff --git a/src/ALE/MOM_hybgen_regrid.F90 b/src/ALE/MOM_hybgen_regrid.F90 index cc961b88f2..f89e15d930 100644 --- a/src/ALE/MOM_hybgen_regrid.F90 +++ b/src/ALE/MOM_hybgen_regrid.F90 @@ -7,7 +7,8 @@ module MOM_hybgen_regrid use MOM_EOS, only : EOS_type, calculate_density use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, assert use MOM_file_parser, only : get_param, param_file_type, log_param -use MOM_io, only : close_file, create_file, file_type, fieldtype, file_exists +use MOM_io, only : create_MOM_file, file_exists +use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, MOM_write_field, vardesc, var_desc, SINGLE_FILE use MOM_string_functions, only : slasher use MOM_unit_scaling, only : unit_scale_type @@ -172,11 +173,11 @@ subroutine init_hybgen_regrid(CS, GV, US, param_file) call get_param(param_file, mdl, "HYBGEN_REMAP_MIN_ZSTAR_DILATE", CS%min_dilate, & "The maximum amount of dilation that is permitted when converting target "//& "coordinates from z to z* [nondim]. This limit applies when drying occurs.", & - default=0.5) + units="nondim", default=0.5) call get_param(param_file, mdl, "HYBGEN_REMAP_MAX_ZSTAR_DILATE", CS%max_dilate, & "The maximum amount of dilation that is permitted when converting target "//& "coordinates from z to z* [nondim]. This limit applies when drying occurs.", & - default=2.0) + units="nondim", default=2.0) CS%onem = 1.0 * GV%m_to_H @@ -210,20 +211,20 @@ subroutine write_Hybgen_coord_file(GV, CS, filepath) character(len=*), intent(in) :: filepath !< The full path to the file to write ! Local variables type(vardesc) :: vars(3) - type(fieldtype) :: fields(3) - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_field) :: fields(3) + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset vars(1) = var_desc("dp0", "meter", "Deep z-level minimum thicknesses for Hybgen", '1', 'L', '1') vars(2) = var_desc("ds0", "meter", "Shallow z-level minimum thicknesses for Hybgen", '1', 'L', '1') vars(3) = var_desc("Rho_tgt", "kg m-3", "Target coordinate potential densities for Hybgen", '1', 'L', '1') - call create_file(IO_handle, trim(filepath), vars, 3, fields, SINGLE_FILE, GV=GV) + call create_MOM_file(IO_handle, trim(filepath), vars, 3, fields, & + SINGLE_FILE, GV=GV) call MOM_write_field(IO_handle, fields(1), CS%dp0k, scale=CS%coord_scale) call MOM_write_field(IO_handle, fields(2), CS%ds0k, scale=CS%coord_scale) call MOM_write_field(IO_handle, fields(3), CS%target_density, scale=CS%Rho_coord_scale) - call close_file(IO_handle) - + call IO_handle%close() end subroutine write_Hybgen_coord_file !> This subroutine deallocates memory in the control structure for the hybgen module diff --git a/src/ALE/MOM_hybgen_remap.F90 b/src/ALE/MOM_hybgen_remap.F90 index 213c6c677e..5ab3e162db 100644 --- a/src/ALE/MOM_hybgen_remap.F90 +++ b/src/ALE/MOM_hybgen_remap.F90 @@ -263,7 +263,7 @@ subroutine hybgen_weno_coefs(s, h_src, edges, nk, ns, thin, PCM_lay) ! real, parameter :: dsmll=1.0e-8 ! This has units of [A2], and hence can not be a parameter. ! real :: curv_cell ! An estimate of the tracer curvature centered on a cell times the grid - ! spacing [A H-1 ~> A m-1 or A kg m-2] + ! spacing [A H-1 ~> A m-1 or A m2 kg-1] real :: seh1, seh2 ! Tracer slopes at the cell edges times the cell grid spacing [A] real :: q01, q02 ! Various tracer differences between a cell average and the edge values [A] real :: q001, q002 ! Tracer slopes at the cell edges times the cell grid spacing [A] @@ -277,7 +277,7 @@ subroutine hybgen_weno_coefs(s, h_src, edges, nk, ns, thin, PCM_lay) ! concentrations and the left and right edges [A2] real :: min_ratio ! The minimum ratio of the values of zw used to interpolate the edge values [nondim] real :: wt1 ! The weight of the upper layer in the interpolated shared edge value [nondim] - real :: slope_edge(nk+1) ! Tracer slopes at the edges [A H-1 ~> A m-1 or A kg m-2] + real :: slope_edge(nk+1) ! Tracer slopes at the edges [A H-1 ~> A m-1 or A m2 kg-1] real :: val_edge(nk+1) ! A weighted average edge concentration [A] integer :: i, k diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index de287af98a..b9d74c01a2 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -6,8 +6,9 @@ module MOM_regridding use MOM_error_handler, only : MOM_error, FATAL, WARNING, assert use MOM_file_parser, only : param_file_type, get_param, log_param use MOM_io, only : file_exists, field_exists, field_size, MOM_read_data -use MOM_io, only : vardesc, var_desc, fieldtype, SINGLE_FILE -use MOM_io, only : create_file, MOM_write_field, close_file, file_type +use MOM_io, only : vardesc, var_desc, SINGLE_FILE +use MOM_io, only : MOM_infra_file, MOM_field +use MOM_io, only : create_MOM_file, MOM_write_field use MOM_io, only : verify_variable_units, slasher use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_grid_type, thermo_var_ptrs @@ -21,7 +22,7 @@ module MOM_regridding use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA use regrid_consts, only : REGRIDDING_ARBITRARY, REGRIDDING_SIGMA_SHELF_ZSTAR -use regrid_consts, only : REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_SLIGHT, REGRIDDING_ADAPTIVE +use regrid_consts, only : REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_ADAPTIVE use regrid_interp, only : interp_CS_type, set_interp_scheme, set_interp_extrap use coord_zlike, only : init_coord_zlike, zlike_CS, set_zlike_params, build_zstar_column, end_coord_zlike @@ -29,7 +30,6 @@ module MOM_regridding use coord_rho, only : init_coord_rho, rho_CS, set_rho_params, build_rho_column, end_coord_rho use coord_rho, only : old_inflate_layers_1d use coord_hycom, only : init_coord_hycom, hycom_CS, set_hycom_params, build_hycom1_column, end_coord_hycom -use coord_slight, only : init_coord_slight, slight_CS, set_slight_params, build_slight_column, end_coord_slight use coord_adapt, only : init_coord_adapt, adapt_CS, set_adapt_params, build_adapt_column, end_coord_adapt use MOM_hybgen_regrid, only : hybgen_regrid, hybgen_regrid_CS, init_hybgen_regrid, end_hybgen_regrid use MOM_hybgen_regrid, only : write_Hybgen_coord_file @@ -60,7 +60,7 @@ module MOM_regridding !! This array is the nominal coordinate of interfaces and is the !! running sum of coordinateResolution, in [R ~> kg m-3]. i.e. !! target_density(k+1) = coordinateResolution(k) + coordinateResolution(k) - !! It is only used in "rho", "SLight" or "Hycom" mode. + !! It is only used in "rho" or "Hycom" mode. real, dimension(:), allocatable :: target_density !> A flag to indicate that the target_density arrays has been filled with data. @@ -120,7 +120,7 @@ module MOM_regridding !> The vintage of the order of arithmetic and expressions to use for remapping. !! Values below 20190101 recover the remapping answers from 2018. !! Higher values use more robust forms of the same remapping expressions. - integer :: remap_answer_date = 20181231 !### Change to 99991231? + integer :: remap_answer_date = 99991231 logical :: use_hybgen_unmix = .false. !< If true, use the hybgen unmixing code before remapping @@ -128,7 +128,6 @@ module MOM_regridding type(sigma_CS), pointer :: sigma_CS => null() !< Control structure for sigma coordinate generator type(rho_CS), pointer :: rho_CS => null() !< Control structure for rho coordinate generator type(hycom_CS), pointer :: hycom_CS => null() !< Control structure for hybrid coordinate generator - type(slight_CS), pointer :: slight_CS => null() !< Control structure for Slight-coordinate generator type(adapt_CS), pointer :: adapt_CS => null() !< Control structure for adaptive coordinate generator type(hybgen_regrid_CS), pointer :: hybgen_CS => NULL() !< Control structure for hybgen regridding @@ -156,7 +155,6 @@ module MOM_regridding " RHO - continuous isopycnal\n"//& " HYCOM1 - HyCOM-like hybrid coordinate\n"//& " HYBGEN - Hybrid coordinate from the Hycom hybgen code\n"//& - " SLIGHT - stretched coordinates above continuous isopycnal\n"//& " ADAPTIVE - optimize for smooth neutral density surfaces" !> Documentation for regridding interpolation schemes @@ -165,6 +163,7 @@ module MOM_regridding " P1M_H4 (2nd-order accurate)\n"//& " P1M_IH4 (2nd-order accurate)\n"//& " PLM (2nd-order accurate)\n"//& + " PPM_CW (3rd-order accurate)\n"//& " PPM_H4 (3rd-order accurate)\n"//& " PPM_IH4 (3rd-order accurate)\n"//& " P3M_IH4IH3 (4th-order accurate)\n"//& @@ -179,6 +178,9 @@ module MOM_regridding !> Default minimum thickness for some coordinate generation modes real, parameter, public :: regriddingDefaultMinThickness = 1.e-3 +!> Maximum length of parameters +integer, parameter :: MAX_PARAM_LENGTH = 120 + #undef __DO_SAFETY_CHECKS__ contains @@ -199,22 +201,22 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m ! Local variables integer :: ke ! Number of levels character(len=80) :: string, string2, varName ! Temporary strings - character(len=40) :: coord_units, param_name, coord_res_param ! Temporary strings + character(len=40) :: coord_units, coord_res_param ! Temporary strings + character(len=MAX_PARAM_LENGTH) :: param_name character(len=200) :: inputdir, fileName character(len=320) :: message ! Temporary strings character(len=12) :: expected_units, alt_units ! Temporary strings - logical :: tmpLogical, fix_haloclines, do_sum, main_parameters + logical :: tmpLogical, do_sum, main_parameters logical :: coord_is_state_dependent, ierr integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: remap_answers_2018 integer :: remap_answer_date ! The vintage of the remapping expressions to use. - real :: filt_len, strat_tol, tmpReal, P_Ref + real :: tmpReal, P_Ref real :: maximum_depth ! The maximum depth of the ocean [m] (not in Z). - real :: dz_fixed_sfc, Rho_avg_depth, nlay_sfc_int real :: adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha real :: adaptDrho0 ! Reference density difference for stratification-dependent diffusion. [R ~> kg m-3] - integer :: nz_fixed_sfc, k, nzf(4) + integer :: k, nzf(4) real, dimension(:), allocatable :: dz ! Resolution (thickness) in units of coordinate, which may be [m] ! or [Z ~> m] or [H ~> m or kg m-2] or [R ~> kg m-3] or other units. real, dimension(:), allocatable :: h_max ! Maximum layer thicknesses [H ~> m or kg m-2] @@ -256,7 +258,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m param_name = "INTERPOLATION_SCHEME" string2 = regriddingDefaultInterpScheme else - param_name = trim(param_prefix)//"_INTERP_SCHEME_"//trim(param_suffix) + param_name = create_coord_param(param_prefix, "INTERP_SCHEME", param_suffix) string2 = 'PPM_H4' ! Default for diagnostics endif call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & @@ -264,7 +266,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m "determine the new grid. These parameters are "//& "only relevant when REGRIDDING_COORDINATE_MODE is "//& "set to a function of state. Otherwise, it is not "//& - "used. It can be one of the following schemes: "//& + "used. It can be one of the following schemes: \n"//& trim(regriddingInterpSchemeDoc), default=trim(string2)) call set_regrid_params(CS, interp_scheme=string) @@ -309,8 +311,8 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m coord_res_param = "ALE_RESOLUTION" string2 = 'UNIFORM' else - param_name = trim(param_prefix)//"_DEF_"//trim(param_suffix) - coord_res_param = trim(param_prefix)//"_RES_"//trim(param_suffix) + param_name = create_coord_param(param_prefix, "DEF", param_suffix) + coord_res_param = create_coord_param(param_prefix, "RES", param_suffix) string2 = 'UNIFORM' if (maximum_depth>3000.) string2='WOA09' ! For convenience endif @@ -483,7 +485,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m if (coordinateMode(coord_mode) == REGRIDDING_ZSTAR .or. & coordinateMode(coord_mode) == REGRIDDING_HYCOM1 .or. & coordinateMode(coord_mode) == REGRIDDING_HYBGEN .or. & - coordinateMode(coord_mode) == REGRIDDING_SLIGHT .or. & coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then ! Adjust target grid to be consistent with maximum_depth tmpReal = sum( dz(:) ) @@ -545,13 +546,22 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m ! initialise coordinate-specific control structure call initCoord(CS, GV, US, coord_mode, param_file) - if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mdl, "P_REF", P_Ref, & - "The pressure that is used for calculating the coordinate "//& - "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& - "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & - units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) - call get_param(param_file, mdl, "REGRID_COMPRESSIBILITY_FRACTION", tmpReal, & + if (coord_is_state_dependent) then + if (main_parameters) then + call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & + "The pressure that is used for calculating the coordinate "//& + "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& + "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", & + units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + else + call get_param(param_file, mdl, create_coord_param(param_prefix, "P_REF", param_suffix), P_Ref, & + "The pressure that is used for calculating the diagnostic coordinate "//& + "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//& + "This is only used for the RHO coordinate.", & + units="Pa", default=2.0e7, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + endif + call get_param(param_file, mdl, create_coord_param(param_prefix, "REGRID_COMPRESSIBILITY_FRACTION", param_suffix), & + tmpReal, & "When interpolating potential density profiles we can add "//& "some artificial compressibility solely to make homogeneous "//& "regions appear stratified.", units="nondim", default=0.) @@ -568,6 +578,13 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call set_regrid_params(CS, min_thickness=0.) endif + if (main_parameters .and. coordinateMode(coord_mode) == REGRIDDING_HYCOM1) then + call get_param(param_file, mdl, "HYCOM1_ONLY_IMPROVES", tmpLogical, & + "When regridding, an interface is only moved if this improves the fit to the target density.", & + default=.false.) + call set_hycom_params(CS%hycom_CS, only_improves=tmpLogical) + endif + CS%use_hybgen_unmix = .false. if (coordinateMode(coord_mode) == REGRIDDING_HYBGEN) then call get_param(param_file, mdl, "USE_HYBGEN_UNMIX", CS%use_hybgen_unmix, & @@ -575,49 +592,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m default=.false.) endif - if (coordinateMode(coord_mode) == REGRIDDING_SLIGHT) then - ! Set SLight-specific regridding parameters. - call get_param(param_file, mdl, "SLIGHT_DZ_SURFACE", dz_fixed_sfc, & - "The nominal thickness of fixed thickness near-surface "//& - "layers with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) - call get_param(param_file, mdl, "SLIGHT_NZ_SURFACE_FIXED", nz_fixed_sfc, & - "The number of fixed-depth surface layers with the SLight "//& - "coordinate.", units="nondimensional", default=2) - call get_param(param_file, mdl, "SLIGHT_SURFACE_AVG_DEPTH", Rho_avg_depth, & - "The thickness of the surface region over which to average "//& - "when calculating the density to use to define the interior "//& - "with the SLight coordinate.", units="m", default=1.0, scale=GV%m_to_H) - call get_param(param_file, mdl, "SLIGHT_NLAY_TO_INTERIOR", nlay_sfc_int, & - "The number of layers to offset the surface density when "//& - "defining where the interior ocean starts with SLight.", & - units="nondimensional", default=2.0) - call get_param(param_file, mdl, "SLIGHT_FIX_HALOCLINES", fix_haloclines, & - "If true, identify regions above the reference pressure "//& - "where the reference pressure systematically underestimates "//& - "the stratification and use this in the definition of the "//& - "interior with the SLight coordinate.", default=.false.) - - call set_regrid_params(CS, dz_min_surface=dz_fixed_sfc, & - nz_fixed_surface=nz_fixed_sfc, Rho_ML_avg_depth=Rho_avg_depth, & - nlay_ML_to_interior=nlay_sfc_int, fix_haloclines=fix_haloclines) - if (fix_haloclines) then - ! Set additional parameters related to SLIGHT_FIX_HALOCLINES. - call get_param(param_file, mdl, "HALOCLINE_FILTER_LENGTH", filt_len, & - "A length scale over which to smooth the temperature and "//& - "salinity before identifying erroneously unstable haloclines.", & - units="m", default=2.0, scale=GV%m_to_H) - call get_param(param_file, mdl, "HALOCLINE_STRAT_TOL", strat_tol, & - "A tolerance for the ratio of the stratification of the "//& - "apparent coordinate stratification to the actual value "//& - "that is used to identify erroneously unstable haloclines. "//& - "This ratio is 1 when they are equal, and sensible values "//& - "are between 0 and 0.5.", units="nondimensional", default=0.2) - call set_regrid_params(CS, halocline_filt_len=filt_len, & - halocline_strat_tol=strat_tol) - endif - - endif - if (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then call get_param(param_file, mdl, "ADAPT_TIME_RATIO", adaptTimeRatio, & "Ratio of ALE timestep to grid timescale.", units="nondim", default=1.0e-1) @@ -696,10 +670,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m call set_regrid_max_depths(CS, z_max, GV%m_to_H) elseif (index(trim(string),'FNC1:')==1) then call dz_function1( trim(string(6:)), dz_max ) - if ((coordinateMode(coord_mode) == REGRIDDING_SLIGHT) .and. & - (dz_fixed_sfc > 0.0)) then - do k=1,nz_fixed_sfc ; dz_max(k) = dz_fixed_sfc ; enddo - endif z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) @@ -781,7 +751,6 @@ subroutine end_regridding(CS) if (associated(CS%sigma_CS)) call end_coord_sigma(CS%sigma_CS) if (associated(CS%rho_CS)) call end_coord_rho(CS%rho_CS) if (associated(CS%hycom_CS)) call end_coord_hycom(CS%hycom_CS) - if (associated(CS%slight_CS)) call end_coord_slight(CS%slight_CS) if (associated(CS%adapt_CS)) call end_coord_adapt(CS%adapt_CS) if (associated(CS%hybgen_CS)) call end_hybgen_regrid(CS%hybgen_CS) @@ -851,13 +820,10 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, & call build_grid_arbitrary( G, GV, h, dzInterface, trickGnuCompiler, CS ) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_HYCOM1 ) - call build_grid_HyCOM1( G, GV, G%US, h, tv, h_new, dzInterface, CS, frac_shelf_h ) + call build_grid_HyCOM1( G, GV, G%US, h, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h ) case ( REGRIDDING_HYBGEN ) call hybgen_regrid(G, GV, G%US, h, tv, CS%hybgen_CS, dzInterface, PCM_cell) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) - case ( REGRIDDING_SLIGHT ) - call build_grid_SLight( G, GV, G%US, h, tv, dzInterface, CS ) - call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) case ( REGRIDDING_ADAPTIVE ) call build_grid_adaptive(G, GV, G%US, h, tv, dzInterface, remapCS, CS) call calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) @@ -901,7 +867,7 @@ subroutine regridding_preadjust_reqs(CS, do_conv_adj, do_hybgen_unmix, hybgen_CS select case ( CS%regridding_scheme ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA, REGRIDDING_ARBITRARY, & - REGRIDDING_HYCOM1, REGRIDDING_SLIGHT, REGRIDDING_ADAPTIVE ) + REGRIDDING_HYCOM1, REGRIDDING_ADAPTIVE ) do_conv_adj = .false. ; do_hybgen_unmix = .false. case ( REGRIDDING_RHO ) do_conv_adj = .true. ; do_hybgen_unmix = .false. @@ -1501,12 +1467,13 @@ end subroutine build_rho_grid !! \remark { Based on Bleck, 2002: An ocean-ice general circulation model framed in !! hybrid isopycnic-Cartesian coordinates, Ocean Modelling 37, 55-88. !! http://dx.doi.org/10.1016/S1463-5003(01)00012-9 } -subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_shelf_h ) +subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, remapCS, CS, frac_shelf_h ) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(remapping_CS), intent(in) :: remapCS !< The remapping control structure type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position @@ -1561,7 +1528,7 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she ( 0.5 * ( z_col(K) + z_col(K+1) ) * (GV%H_to_RZ*GV%g_Earth) - tv%P_Ref ) enddo - call build_hycom1_column(CS%hycom_CS, tv%eqn_of_state, GV%ke, nominalDepth, & + call build_hycom1_column(CS%hycom_CS, remapCS, tv%eqn_of_state, GV%ke, nominalDepth, & h(i,j,:), tv%T(i,j,:), tv%S(i,j,:), p_col, & z_col, z_col_new, zScale=GV%Z_to_H, & h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) @@ -1648,84 +1615,6 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS) enddo ; enddo end subroutine build_grid_adaptive -!> Builds a grid that tracks density interfaces for water that is denser than -!! the surface density plus an increment of some number of layers, and uses all -!! lighter layers uniformly above this location. Note that this amounts to -!! interpolating to find the depth of an arbitrary (non-integer) interface index -!! which should make the results vary smoothly in space to the extent that the -!! surface density and interior stratification vary smoothly in space. Over -!! shallow topography, this will tend to give a uniform sigma-like coordinate. -!! For sufficiently shallow water, a minimum grid spacing is used to avoid -!! certain instabilities. -subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(regridding_CS), intent(in) :: CS !< Regridding control structure - real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position - - real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure in the input column [R L2 T-2 ~> Pa] - real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(CS%nk+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - - ! 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 - - if (CS%remap_answer_date >= 20190101) then - h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff - elseif (GV%Boussinesq) then - h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 - else - h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 - endif - - nz = GV%ke - - call assert((GV%ke == CS%nk), "build_grid_SLight is only written to work "//& - "with the same number of input and target layers.") - call assert(CS%target_density_set, "build_grid_SLight : "//& - "Target densities must be set before build_grid_SLight is called.") - - ! Build grid based on target interface densities - 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)+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) - p_col(k) = tv%P_Ref + CS%compressibility_fraction * & - ( 0.5 * ( z_col(K) + z_col(K+1) ) * (GV%H_to_RZ*GV%g_Earth) - tv%P_Ref ) - enddo - - call build_slight_column(CS%slight_CS, tv%eqn_of_state, GV%H_to_RZ*GV%g_Earth, & - GV%H_subroundoff, nz, depth, h(i, j, :), & - tv%T(i, j, :), tv%S(i, j, :), p_col, z_col, z_col_new, & - h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) - - ! Calculate the final change in grid position after blending new and old grids - call filtered_grid_motion( CS, nz, z_col, z_col_new, dz_col ) - do K=1,nz+1 ; dzInterface(i,j,K) = -dz_col(K) ; enddo -#ifdef __DO_SAFETY_CHECKS__ - if (dzInterface(i,j,1) /= 0.) stop 'build_grid_SLight: Surface moved?!' - if (dzInterface(i,j,nz+1) /= 0.) stop 'build_grid_SLight: Bottom moved?!' -#endif - - ! This adjusts things robust to round-off errors - call adjust_interface_motion( CS, nz, h(i,j,:), dzInterface(i,j,:) ) - - else ! on land - dzInterface(i,j,:) = 0. - endif ! mask2dT - enddo ; enddo ! i,j - -end subroutine build_grid_SLight - !> Adjust dz_Interface to ensure non-negative future thicknesses subroutine adjust_interface_motion( CS, nk, h_old, dz_int ) type(regridding_CS), intent(in) :: CS !< Regridding control structure @@ -2019,7 +1908,7 @@ function uniformResolution(nk,coordMode,maxDepth,rhoLight,rhoHeavy) scheme = coordinateMode(coordMode) select case ( scheme ) - case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_SLIGHT, & + case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, & REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_ADAPTIVE ) uniformResolution(:) = maxDepth / real(nk) @@ -2062,9 +1951,6 @@ subroutine initCoord(CS, GV, US, coord_mode, param_file) CS%interp_CS) case (REGRIDDING_HYBGEN) call init_hybgen_regrid(CS%hybgen_CS, GV, US, param_file) - case (REGRIDDING_SLIGHT) - call init_coord_slight(CS%slight_CS, CS%nk, CS%ref_pressure, CS%target_density, & - CS%interp_CS, GV%m_to_H) case (REGRIDDING_ADAPTIVE) call init_coord_adapt(CS%adapt_CS, CS%nk, CS%coordinateResolution, GV%m_to_H, US%kg_m3_to_R) end select @@ -2158,8 +2044,6 @@ subroutine set_regrid_max_depths( CS, max_depths, units_to_H ) select case (CS%regridding_scheme) case (REGRIDDING_HYCOM1) call set_hycom_params(CS%hycom_CS, max_interface_depths=CS%max_interface_depths) - case (REGRIDDING_SLIGHT) - call set_slight_params(CS%slight_CS, max_interface_depths=CS%max_interface_depths) end select end subroutine set_regrid_max_depths @@ -2184,8 +2068,6 @@ subroutine set_regrid_max_thickness( CS, max_h, units_to_H ) select case (CS%regridding_scheme) case (REGRIDDING_HYCOM1) call set_hycom_params(CS%hycom_CS, max_layer_thickness=CS%max_layer_thickness) - case (REGRIDDING_SLIGHT) - call set_slight_params(CS%slight_CS, max_layer_thickness=CS%max_layer_thickness) end select end subroutine set_regrid_max_thickness @@ -2199,8 +2081,8 @@ subroutine write_regrid_file( CS, GV, filepath ) character(len=*), intent(in) :: filepath !< The full path to the file to write type(vardesc) :: vars(2) - type(fieldtype) :: fields(2) - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_field) :: fields(2) + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset real :: ds(GV%ke), dsi(GV%ke+1) if (CS%regridding_scheme == REGRIDDING_HYBGEN) then @@ -2218,10 +2100,11 @@ subroutine write_regrid_file( CS, GV, filepath ) vars(2) = var_desc('ds_interface', getCoordinateUnits( CS ), & 'Layer Center Coordinate Separation', '1', 'i', '1') - call create_file(IO_handle, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) + call create_MOM_file(IO_handle, trim(filepath), vars, 2, fields, & + SINGLE_FILE, GV=GV) call MOM_write_field(IO_handle, fields(1), ds) call MOM_write_field(IO_handle, fields(2), dsi) - call close_file(IO_handle) + call IO_handle%close() end subroutine write_regrid_file @@ -2296,7 +2179,7 @@ function getCoordinateUnits( CS ) character(len=20) :: getCoordinateUnits select case ( CS%regridding_scheme ) - case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, REGRIDDING_SLIGHT, & + case ( REGRIDDING_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, & REGRIDDING_ADAPTIVE ) getCoordinateUnits = 'meter' case ( REGRIDDING_SIGMA_SHELF_ZSTAR ) @@ -2337,8 +2220,6 @@ function getCoordinateShortName( CS ) getCoordinateShortName = 'z-rho' case ( REGRIDDING_HYBGEN ) getCoordinateShortName = 'hybrid' - case ( REGRIDDING_SLIGHT ) - getCoordinateShortName = 's-rho' case ( REGRIDDING_ADAPTIVE ) getCoordinateShortName = 'adaptive' case default @@ -2351,8 +2232,7 @@ end function getCoordinateShortName !> Can be used to set any of the parameters for MOM_regridding. subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_grid_weight, & interp_scheme, depth_of_time_filter_shallow, depth_of_time_filter_deep, & - compress_fraction, ref_pressure, dz_min_surface, nz_fixed_surface, Rho_ML_avg_depth, & - nlay_ML_to_interior, fix_haloclines, halocline_filt_len, halocline_strat_tol, & + compress_fraction, ref_pressure, & integrate_downward_for_e, remap_answers_2018, remap_answer_date, & adaptTimeRatio, adaptZoom, adaptZoomCoeff, adaptBuoyCoeff, adaptAlpha, adaptDoMin, adaptDrho0) type(regridding_CS), intent(inout) :: CS !< Regridding control structure @@ -2366,18 +2246,6 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri real, optional, intent(in) :: compress_fraction !< Fraction of compressibility to add to potential density [nondim] real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent !! coordinates [R L2 T-2 ~> Pa] - real, optional, intent(in) :: dz_min_surface !< The fixed resolution in the topmost - !! SLight_nkml_min layers [H ~> m or kg m-2] - integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the top of the model - real, optional, intent(in) :: Rho_ml_avg_depth !< Averaging depth over which to determine mixed layer potential - !! density [H ~> m or kg m-2] - real, optional, intent(in) :: nlay_ML_to_interior !< Number of layers to offset the mixed layer density to find - !! resolved stratification [nondim] - logical, optional, intent(in) :: fix_haloclines !< Detect regions with much weaker stratification in the coordinate - real, optional, intent(in) :: halocline_filt_len !< Length scale over which to filter T & S when looking for - !! spuriously unstable water mass profiles [H ~> m or kg m-2] - real, optional, intent(in) :: halocline_strat_tol !< Value of the stratification ratio that defines a problematic - !! halocline region. logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface positions downward !! from the top. logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions @@ -2432,6 +2300,7 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri if (present(min_thickness)) call set_sigma_params(CS%sigma_CS, min_thickness=min_thickness) case (REGRIDDING_RHO) if (present(min_thickness)) call set_rho_params(CS%rho_CS, min_thickness=min_thickness) + if (present(ref_pressure)) call set_rho_params(CS%rho_CS, ref_pressure=ref_pressure) if (present(integrate_downward_for_e)) & call set_rho_params(CS%rho_CS, integrate_downward_for_e=integrate_downward_for_e) if (associated(CS%rho_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & @@ -2441,18 +2310,6 @@ subroutine set_regrid_params( CS, boundary_extrapolation, min_thickness, old_gri call set_hycom_params(CS%hycom_CS, interp_CS=CS%interp_CS) case (REGRIDDING_HYBGEN) ! Do nothing for now. - case (REGRIDDING_SLIGHT) - if (present(min_thickness)) call set_slight_params(CS%slight_CS, min_thickness=min_thickness) - if (present(dz_min_surface)) call set_slight_params(CS%slight_CS, dz_ml_min=dz_min_surface) - if (present(nz_fixed_surface)) call set_slight_params(CS%slight_CS, nz_fixed_surface=nz_fixed_surface) - if (present(Rho_ML_avg_depth)) call set_slight_params(CS%slight_CS, Rho_ML_avg_depth=Rho_ML_avg_depth) - if (present(nlay_ML_to_interior)) call set_slight_params(CS%slight_CS, nlay_ML_offset=nlay_ML_to_interior) - if (present(fix_haloclines)) call set_slight_params(CS%slight_CS, fix_haloclines=fix_haloclines) - if (present(halocline_filt_len)) call set_slight_params(CS%slight_CS, halocline_filter_length=halocline_filt_len) - if (present(halocline_strat_tol)) call set_slight_params(CS%slight_CS, halocline_strat_tol=halocline_strat_tol) - if (present(compress_fraction)) call set_slight_params(CS%slight_CS, compressibility_fraction=compress_fraction) - if (associated(CS%slight_CS) .and. (present(interp_scheme) .or. present(boundary_extrapolation))) & - call set_slight_params(CS%slight_CS, interp_CS=CS%interp_CS) case (REGRIDDING_ADAPTIVE) if (present(adaptTimeRatio)) call set_adapt_params(CS%adapt_CS, adaptTimeRatio=adaptTimeRatio) if (present(adaptZoom)) call set_adapt_params(CS%adapt_CS, adaptZoom=adaptZoom) @@ -2510,7 +2367,7 @@ function getStaticThickness( CS, SSH, depth ) select case ( CS%regridding_scheme ) case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_HYCOM1, REGRIDDING_HYBGEN, & - REGRIDDING_SLIGHT, REGRIDDING_ADAPTIVE ) + REGRIDDING_ADAPTIVE ) if (depth>0.) then z = ssh do k = 1, CS%nk @@ -2564,6 +2421,29 @@ subroutine dz_function1( string, dz ) end subroutine dz_function1 +!> Construct the name of a parameter for a specific coordinate based on param_prefix and param_suffix. For the main, +!! prognostic coordinate this will simply return the parameter name (e.g. P_REF) +function create_coord_param(param_prefix, param_name, param_suffix) result(coord_param) + character(len=*) :: param_name !< The base name of the parameter (e.g. the one used for the main coordinate) + character(len=*) :: param_prefix !< String to prefix to parameter names. + character(len=*) :: param_suffix !< String to append to parameter names. + character(len=MAX_PARAM_LENGTH) :: coord_param !< Parameter name prepended by param_prefix + !! and appended with param_suffix + integer :: out_length + + if (len_trim(param_prefix) + len_trim(param_suffix) == 0) then + coord_param = param_name + else + ! Note the +2 is because of two underscores + out_length = len_trim(param_name)+len_trim(param_prefix)+len_trim(param_suffix)+2 + if (out_length > MAX_PARAM_LENGTH) then + call MOM_error(FATAL,"Coordinate parameter is too long; increase MAX_PARAM_LENGTH") + endif + coord_param = TRIM(param_prefix)//"_"//TRIM(param_name)//"_"//TRIM(param_suffix) + endif + +end function create_coord_param + !> Parses a string and generates a rho_target(:) profile with refined resolution downward !! and returns the number of levels integer function rho_function1( string, rho_target ) diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index faed4ac6be..eeb4590a08 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -5,23 +5,24 @@ module MOM_remapping ! Original module written by Laurent White, 2008.06.09 use MOM_error_handler, only : MOM_error, FATAL +use MOM_io, only : stdout, stderr use MOM_string_functions, only : uppercase use regrid_edge_values, only : edge_values_explicit_h4, edge_values_implicit_h4 +use regrid_edge_values, only : edge_values_explicit_h4cw use regrid_edge_values, only : edge_values_implicit_h4, edge_values_implicit_h6 use regrid_edge_values, only : edge_slopes_implicit_h3, edge_slopes_implicit_h5 +use remapping_attic, only : remapping_attic_unit_tests use PCM_functions, only : PCM_reconstruction use PLM_functions, only : PLM_reconstruction, PLM_boundary_extrapolation use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use PPM_functions, only : PPM_monotonicity use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 use MOM_hybgen_remap, only : hybgen_plm_coefs, hybgen_ppm_coefs, hybgen_weno_coefs -use MOM_io, only : stdout, stderr - implicit none ; private !> Container for remapping parameters -type, public :: remapping_CS - private +type, public :: remapping_CS ; private !> Determines which reconstruction to use integer :: remapping_scheme = -911 !> Degree of polynomial reconstruction @@ -36,19 +37,20 @@ module MOM_remapping logical :: force_bounds_in_subcell = .false. !> The vintage of the expressions to use for remapping. Values below 20190101 result !! in the use of older, less accurate expressions. - integer :: answer_date = 20181231 !### Change to 99991231? + integer :: answer_date = 99991231 end type ! The following routines are visible to the outside world public remapping_core_h, remapping_core_w public initialize_remapping, end_remapping, remapping_set_param, extract_member_remapping_CS public remapping_unit_tests, build_reconstructions_1d, average_value_ppoly -public dzFromH1H2 +public interpolate_column, reintegrate_column, dzFromH1H2 ! The following are private parameter constants integer, parameter :: REMAPPING_PCM = 0 !< O(h^1) remapping scheme integer, parameter :: REMAPPING_PLM = 2 !< O(h^2) remapping scheme integer, parameter :: REMAPPING_PLM_HYBGEN = 3 !< O(h^2) remapping scheme +integer, parameter :: REMAPPING_PPM_CW =10 !< O(h^3) remapping scheme integer, parameter :: REMAPPING_PPM_H4 = 4 !< O(h^3) remapping scheme integer, parameter :: REMAPPING_PPM_IH4 = 5 !< O(h^3) remapping scheme integer, parameter :: REMAPPING_PPM_HYBGEN = 6 !< O(h^3) remapping scheme @@ -76,20 +78,6 @@ module MOM_remapping "PQM_IH6IH5 (5th-order accurate)\n" character(len=3), public :: remappingDefaultScheme = "PLM" !< Default remapping method -! This CPP macro turns on/off bounding of integrations limits so that they are -! always within the cell. Roundoff can lead to the non-dimensional bounds being -! outside of the range 0 to 1. -#define __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - -real, parameter :: hNeglect_dflt = 1.E-30 !< A thickness [H ~> m or kg m-2] that can be - !! added to thicknesses in a denominator without - !! changing the numerical result, except where - !! a division by zero would otherwise occur. - -logical, parameter :: old_algorithm = .false. !< Use the old "broken" algorithm. - !! This is a temporary measure to assist - !! debugging until we delete the old algorithm. - contains !> Set parameters within remapping object @@ -101,7 +89,7 @@ subroutine remapping_set_param(CS, remapping_scheme, boundary_extrapolation, & logical, optional, intent(in) :: check_reconstruction !< Indicate to check reconstructions logical, optional, intent(in) :: check_remapping !< Indicate to check results of remapping logical, optional, intent(in) :: force_bounds_in_subcell !< Force subcells values to be bounded - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + logical, optional, intent(in) :: answers_2018 !< If true use older, less accurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use if (present(remapping_scheme)) then @@ -152,11 +140,12 @@ subroutine extract_member_remapping_CS(CS, remapping_scheme, degree, boundary_ex if (present(force_bounds_in_subcell)) force_bounds_in_subcell = CS%force_bounds_in_subcell end subroutine extract_member_remapping_CS + !> Calculate edge coordinate x from cell width h subroutine buildGridFromH(nz, h, x) integer, intent(in) :: nz !< Number of cells - real, dimension(nz), intent(in) :: h !< Cell widths - real, dimension(nz+1), intent(inout) :: x !< Edge coordiantes starting at x(1)=0 + real, dimension(nz), intent(in) :: h !< Cell widths [H] + real, dimension(nz+1), intent(inout) :: x !< Edge coordinates starting at x(1)=0 [H] ! Local variables integer :: k @@ -167,39 +156,6 @@ subroutine buildGridFromH(nz, h, x) end subroutine buildGridFromH -!> Compare two summation estimates of positive data and judge if due to more -!! than round-off. -!! When two sums are calculated from different vectors that should add up to -!! the same value, the results can differ by round off. The round off error -!! can be bounded to be proportional to the number of operations. -!! This function returns true if the difference between sum1 and sum2 is -!! larger than than the estimated round off bound. -!! \note This estimate/function is only valid for summation of positive data. -function isPosSumErrSignificant(n1, sum1, n2, sum2) - integer, intent(in) :: n1 !< Number of values in sum1 - integer, intent(in) :: n2 !< Number of values in sum2 - real, intent(in) :: sum1 !< Sum of n1 values - real, intent(in) :: sum2 !< Sum of n2 values - logical :: isPosSumErrSignificant !< True if difference in sums is large - ! Local variables - real :: sumErr, allowedErr, eps - - if (sum1<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum1<0 is not allowed!') - if (sum2<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum2<0 is not allowed!') - sumErr = abs(sum1-sum2) - eps = epsilon(sum1) - allowedErr = eps*0.5*(real(n1-1)*sum1+real(n2-1)*sum2) - if (sumErr>allowedErr) then - write(0,*) 'isPosSumErrSignificant: sum1,sum2=',sum1,sum2 - write(0,*) 'isPosSumErrSignificant: eps=',eps - write(0,*) 'isPosSumErrSignificant: err,n*eps=',sumErr,allowedErr - write(0,*) 'isPosSumErrSignificant: err/eps,n1,n2,n1+n2=',sumErr/eps,n1,n2,n1+n2 - isPosSumErrSignificant = .true. - else - isPosSumErrSignificant = .false. - endif -end function isPosSumErrSignificant - !> Remaps column of values u0 on grid h0 to grid h1 assuming the top edge is aligned. subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edge, PCM_cell) type(remapping_CS), intent(in) :: CS !< Remapping control structure @@ -219,17 +175,12 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edg !! cells in the source grid where this is true. ! Local variables - integer :: iMethod - real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial - real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial - real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial - real :: h0tot, h0err ! Sum of source cell widths and round-off error in this sum [H] - real :: h1tot, h1err ! Sum of target cell widths and round-off error in this sum [H] - real :: u0tot, u0err ! Integrated values on the source grid and round-off error in this sum [H A] - real :: u1tot, u1err ! Integrated values on the target grid and round-off error in this sum [H A] - real :: u0min, u0max, u1min, u1max ! Extrema of values on the two grids [A] - real :: uh_err ! Difference in the total amounts on the two grids [H A] + real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial [A] + real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial [A H-1] + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial reconstructions [A] + real :: uh_err ! A bound on the error in the sum of u*h, as estimated by the remapping code [A H] real :: hNeglect, hNeglect_edge ! Negligibly small cell widths in the same units as h0 [H] + integer :: iMethod ! An integer indicating the integration method used integer :: k hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect @@ -244,72 +195,36 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_edg call remap_via_sub_cells( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, h1, iMethod, & CS%force_bounds_in_subcell, u1, uh_err ) - if (CS%check_remapping) then - ! Check errors and bounds - call measure_input_bounds( n0, h0, u0, ppoly_r_E, h0tot, h0err, u0tot, u0err, u0min, u0max ) - call measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) - if (iMethod<5) then ! We except PQM until we've debugged it - if ( (abs(u1tot-u0tot)>(u0err+u1err)+uh_err .and. abs(h1tot-h0tot)u0max) ) then - write(0,*) 'iMethod = ',iMethod - write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) & - write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' - write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & - write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' - write(0,*) 'U: u0min=',u0min,'u1min=',u1min - if (u1minn0) then - write(0,'(i3,96x,1p2e24.16)') k,h1(k),u1(k) - else - write(0,'(i3,1p4e24.16)') k,h0(k),ppoly_r_E(k,1),u0(k),ppoly_r_E(k,2) - endif - enddo - write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' - do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) - enddo - call MOM_error( FATAL, 'MOM_remapping, remapping_core_h: '//& - 'Remapping result is inconsistent!' ) - endif - endif ! method<5 - endif + if (CS%check_remapping) call check_remapped_values(n0, h0, u0, ppoly_r_E, CS%degree, ppoly_r_coefs, & + n1, h1, u1, iMethod, uh_err, "remapping_core_h") end subroutine remapping_core_h !> Remaps column of values u0 on grid h0 to implied grid h1 !! where the interfaces of h1 differ from those of h0 by dx. subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_edge ) - type(remapping_CS), intent(in) :: CS !< Remapping control structure - integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid - integer, intent(in) :: n1 !< Number of cells on target grid - real, dimension(n1+1), intent(in) :: dx !< Cell widths on target grid - real, dimension(n1), intent(out) :: u1 !< Cell averages on target grid - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h0. - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width - !! for the purpose of edge value - !! calculations in the same units as h0. + type(remapping_CS), intent(in) :: CS !< Remapping control structure + integer, intent(in) :: n0 !< Number of cells on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] + integer, intent(in) :: n1 !< Number of cells on target grid + real, dimension(n1+1), intent(in) :: dx !< Cell widths on target grid [H] + real, dimension(n1), intent(out) :: u1 !< Cell averages on target grid [A] + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h0 [H]. + real, optional, intent(in) :: h_neglect_edge !< A negligibly small width + !! for the purpose of edge value + !! calculations in the same units as h0 [H]. ! Local variables - integer :: iMethod - real, dimension(n0,2) :: ppoly_r_E !Edge value of polynomial - real, dimension(n0,2) :: ppoly_r_S !Edge slope of polynomial - real, dimension(n0,CS%degree+1) :: ppoly_r_coefs !Coefficients of polynomial + real, dimension(n0,2) :: ppoly_r_E ! Edge value of polynomial [A] + real, dimension(n0,2) :: ppoly_r_S ! Edge slope of polynomial [A H-1] + real, dimension(n0,CS%degree+1) :: ppoly_r_coefs ! Coefficients of polynomial reconstructions [A] + real, dimension(n1) :: h1 !< Cell widths on target grid [H] + real :: uh_err ! A bound on the error in the sum of u*h, as estimated by the remapping code [A H] + real :: hNeglect, hNeglect_edge ! Negligibly small thicknesses [H] + integer :: iMethod ! An integer indicating the integration method used integer :: k - real :: h0tot, h0err, h1tot, h1err - real :: u0tot, u0err, u0min, u0max, u1tot, u1err, u1min, u1max, uh_err - real, dimension(n1) :: h1 !< Cell widths on target grid - real :: hNeglect, hNeglect_edge hNeglect = 1.0e-30 ; if (present(h_neglect)) hNeglect = h_neglect hNeglect_edge = 1.0e-10 ; if (present(h_neglect_edge)) hNeglect_edge = h_neglect_edge @@ -333,43 +248,8 @@ subroutine remapping_core_w( CS, n0, h0, u0, n1, dx, u1, h_neglect, h_neglect_ed ! call remapByDeltaZ( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, n1, dx, iMethod, u1, hNeglect ) ! call remapByProjection( n0, h0, u0, CS%ppoly_r, n1, h1, iMethod, u1, hNeglect ) - if (CS%check_remapping) then - ! Check errors and bounds - call measure_input_bounds( n0, h0, u0, ppoly_r_E, h0tot, h0err, u0tot, u0err, u0min, u0max ) - call measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) - if (iMethod<5) then ! We except PQM until we've debugged it - if ( (abs(u1tot-u0tot)>(u0err+u1err)+uh_err .and. abs(h1tot-h0tot)u0max) ) then - write(0,*) 'iMethod = ',iMethod - write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) & - write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' - write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & - write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' - write(0,*) 'U: u0min=',u0min,'u1min=',u1min - if (u1minn0) then - write(0,'(i3,96x,1p2e24.16)') k,h1(k),u1(k) - else - write(0,'(i3,1p4e24.16)') k,h0(k),ppoly_r_E(k,1),u0(k),ppoly_r_E(k,2) - endif - enddo - write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' - do k = 1, n0 - write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) - enddo - call MOM_error( FATAL, 'MOM_remapping, remapping_core_w: '//& - 'Remapping result is inconsistent!' ) - endif - endif ! method<5 - endif + if (CS%check_remapping) call check_remapped_values(n0, h0, u0, ppoly_r_E, CS%degree, ppoly_r_coefs, & + n1, h1, u1, iMethod, uh_err, "remapping_core_w") end subroutine remapping_core_w @@ -379,19 +259,19 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & h_neglect_edge, PCM_cell ) type(remapping_CS), intent(in) :: CS !< Remapping control structure integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] real, dimension(n0,CS%degree+1), & - intent(out) :: ppoly_r_coefs !< Coefficients of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial + intent(out) :: ppoly_r_coefs !< Coefficients of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial [A H-1] integer, intent(out) :: iMethod !< Integration method real, optional, intent(in) :: h_neglect !< A negligibly small width for the !! purpose of cell reconstructions - !! in the same units as h0. + !! in the same units as h0 [H] real, optional, intent(in) :: h_neglect_edge !< A negligibly small width !! for the purpose of edge value - !! calculations in the same units as h0. + !! calculations in the same units as h0 [H] logical, optional, intent(in) :: PCM_cell(n0) !< If present, use PCM remapping for !! cells from the source grid where this is true. @@ -410,7 +290,7 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & local_remapping_scheme = REMAPPING_PCM elseif (n0<=3) then local_remapping_scheme = min( local_remapping_scheme, REMAPPING_PLM ) - elseif (n0<=4) then + elseif (n0<=4 .and. local_remapping_scheme /= REMAPPING_PPM_CW ) then local_remapping_scheme = min( local_remapping_scheme, REMAPPING_PPM_H4 ) endif select case ( local_remapping_scheme ) @@ -433,6 +313,15 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, & if ( CS%boundary_extrapolation ) & call PLM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) iMethod = INTEGRATION_PLM + case ( REMAPPING_PPM_CW ) + ! identical to REMAPPING_PPM_HYBGEN + call edge_values_explicit_h4cw( n0, h0, u0, ppoly_r_E, h_neglect_edge ) + call PPM_monotonicity( n0, u0, ppoly_r_E ) + call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=CS%answer_date ) + if ( CS%boundary_extrapolation ) then + call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect ) + endif + iMethod = INTEGRATION_PPM case ( REMAPPING_PPM_H4 ) call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answer_date=CS%answer_date ) call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect, answer_date=CS%answer_date ) @@ -500,17 +389,17 @@ end subroutine build_reconstructions_1d subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & ppoly_r_coefs, ppoly_r_E, ppoly_r_S) integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] integer, intent(in) :: deg !< Degree of polynomial reconstruction logical, intent(in) :: boundary_extrapolation !< Extrapolate at boundaries if true - real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefs !< Coefficients of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial - real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial + real, dimension(n0,deg+1),intent(out) :: ppoly_r_coefs !< Coefficients of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_E !< Edge value of polynomial [A] + real, dimension(n0,2), intent(out) :: ppoly_r_S !< Edge slope of polynomial [A H-1] ! Local variables integer :: i0, n - real :: u_l, u_c, u_r ! Cell averages - real :: u_min, u_max + real :: u_l, u_c, u_r ! Cell averages [A] + real :: u_min, u_max ! Cell extrema [A] logical :: problem_detected problem_detected = .false. @@ -573,18 +462,18 @@ end subroutine check_reconstructions_1d !! appropriate integrals into the h1*u1 values. h0 and h1 must have the same units. subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, method, & force_bounds_in_subcell, u1, uh_err, ah_sub, aisub_src, aiss, aise ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: h0(n0) !< Source grid widths (size n0) - real, intent(in) :: u0(n0) !< Source cell averages (size n0) - real, intent(in) :: ppoly0_E(n0,2) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, intent(in) :: h1(n1) !< Target grid widths (size n1) - integer, intent(in) :: method !< Remapping scheme to use + integer, intent(in) :: n0 !< Number of cells in source grid + real, intent(in) :: h0(n0) !< Source grid widths (size n0) [H] + real, intent(in) :: u0(n0) !< Source cell averages (size n0) [A] + real, intent(in) :: ppoly0_E(n0,2) !< Edge value of polynomial [A] + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial [A] + integer, intent(in) :: n1 !< Number of cells in target grid + real, intent(in) :: h1(n1) !< Target grid widths (size n1) [H] + integer, intent(in) :: method !< Remapping scheme to use logical, intent(in) :: force_bounds_in_subcell !< Force sub-cell values to be bounded - real, intent(out) :: u1(n1) !< Target cell averages (size n1) - real, intent(out) :: uh_err !< Estimate of bound on error in sum of u*h - real, optional, intent(out) :: ah_sub(n0+n1+1) !< h_sub + real, intent(out) :: u1(n1) !< Target cell averages (size n1) [A] + real, intent(out) :: uh_err !< Estimate of bound on error in sum of u*h [A H] + real, optional, intent(out) :: ah_sub(n0+n1+1) !< Overlapping sub-cell thicknesses, h_sub [H] integer, optional, intent(out) :: aisub_src(n0+n1+1) !< i_sub_src integer, optional, intent(out) :: aiss(n0) !< isrc_start integer, optional, intent(out) :: aise(n0) !< isrc_ens @@ -595,36 +484,38 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth integer :: i_start0 ! Used to record which sub-cells map to source cells integer :: i_start1 ! Used to record which sub-cells map to target cells integer :: i_max ! Used to record which sub-cell is the largest contribution of a source cell - real :: dh_max ! Used to record which sub-cell is the largest contribution of a source cell - real, dimension(n0+n1+1) :: h_sub ! Width of each each sub-cell - real, dimension(n0+n1+1) :: uh_sub ! Integral of u*h over each sub-cell - real, dimension(n0+n1+1) :: u_sub ! Average of u over each sub-cell + real :: dh_max ! Used to record which sub-cell is the largest contribution of a source cell [H] + real, dimension(n0+n1+1) :: h_sub ! Width of each each sub-cell [H] + real, dimension(n0+n1+1) :: uh_sub ! Integral of u*h over each sub-cell [A H] + real, dimension(n0+n1+1) :: u_sub ! Average of u over each sub-cell [A] integer, dimension(n0+n1+1) :: isub_src ! Index of source cell for each sub-cell integer, dimension(n0) :: isrc_start ! Index of first sub-cell within each source cell integer, dimension(n0) :: isrc_end ! Index of last sub-cell within each source cell integer, dimension(n0) :: isrc_max ! Index of thickest sub-cell within each source cell - real, dimension(n0) :: h0_eff ! Effective thickness of source cells - real, dimension(n0) :: u0_min ! Minimum value of reconstructions in source cell - real, dimension(n0) :: u0_max ! Minimum value of reconstructions in source cell + real, dimension(n0) :: h0_eff ! Effective thickness of source cells [H] + real, dimension(n0) :: u0_min ! Minimum value of reconstructions in source cell [A] + real, dimension(n0) :: u0_max ! Minimum value of reconstructions in source cell [A] integer, dimension(n1) :: itgt_start ! Index of first sub-cell within each target cell integer, dimension(n1) :: itgt_end ! Index of last sub-cell within each target cell - real :: xa, xb ! Non-dimensional position within a source cell (0..1) - real :: h0_supply, h1_supply ! The amount of width available for constructing sub-cells - real :: dh ! The width of the sub-cell - real :: duh ! The total amount of accumulated stuff (u*h) - real :: dh0_eff ! Running sum of source cell thickness + real :: xa, xb ! Non-dimensional position within a source cell (0..1) [nondim] + real :: h0_supply, h1_supply ! The amount of width available for constructing sub-cells [H] + real :: dh ! The width of the sub-cell [H] + real :: duh ! The total amount of accumulated stuff (u*h) [A H] + real :: dh0_eff ! Running sum of source cell thickness [H] ! For error checking/debugging logical, parameter :: force_bounds_in_target = .true. ! To fix round-off issues logical, parameter :: adjust_thickest_subcell = .true. ! To fix round-off conservation issues logical, parameter :: debug_bounds = .false. ! For debugging overshoots etc. integer :: k, i0_last_thick_cell - real :: h0tot, h0err, h1tot, h1err, h2tot, h2err, u02_err - real :: u0tot, u0err, u0min, u0max, u1tot, u1err, u1min, u1max, u2tot, u2err, u2min, u2max, u_orig + real :: h0tot, h1tot, h2tot ! Summed thicknesses used for debugging [H] + real :: h0err, h1err, h2err ! Estimates of round-off errors used for debugging [H] + real :: u02_err, u0err, u1err, u2err ! Integrated reconstruction error estimates [H A] + real :: u0tot, u1tot, u2tot ! Integrated reconstruction values [H A] + real :: u_orig ! The original value of the reconstruction in a cell [A] + real :: u0min, u0max, u1min, u1max, u2min, u2max ! Minimum and maximum values of reconstructions [A] logical :: src_has_volume !< True if h0 has not been consumed logical :: tgt_has_volume !< True if h1 has not been consumed - if (old_algorithm) isrc_max(:)=1 - i0_last_thick_cell = 0 do i0 = 1, n0 u0_min(i0) = min(ppoly0_E(i0,1), ppoly0_E(i0,2)) @@ -692,28 +583,13 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth ! Record the source cell thickness found by summing the sub-cell thicknesses. h0_eff(i0) = dh0_eff ! Move the source index. - if (old_algorithm) then - if (i0 < i0_last_thick_cell) then - i0 = i0 + 1 - h0_supply = h0(i0) - dh0_eff = 0. - do while (h0_supply==0. .and. i0= h1_supply .and. tgt_has_volume) then ! h1_supply is smaller than h0_supply) so we consume h1_supply and increment the @@ -729,12 +605,8 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth i1 = i1 + 1 h1_supply = h1(i1) else - if (old_algorithm) then - h1_supply = 1.E30 - else - h1_supply = 0. - tgt_has_volume = .false. - endif + h1_supply = 0. + tgt_has_volume = .false. endif elseif (src_has_volume) then ! We ran out of target volume but still have source cells to consume @@ -979,23 +851,167 @@ subroutine remap_via_sub_cells( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, h1, meth end subroutine remap_via_sub_cells +!> Linearly interpolate interface data, u_src, from grid h_src to a grid h_dest +subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest, mask_edges) + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces [A] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces [A] + logical, intent(in) :: mask_edges !< If true, mask the values outside of massless + !! layers at the top and bottom of the column. + + ! Local variables + real :: x_dest ! Relative position of target interface [H] + real :: dh ! Source cell thickness [H] + real :: frac_pos(ndest+1) ! Fractional position of the destination interface + ! within the source layer [nondim], 0 <= frac_pos <= 1. + integer :: k_src(ndest+1) ! Source grid layer index of destination interface, 1 <= k_src <= ndest. + integer :: ks, k_dest ! Index of cell in src and dest columns + + ! The following forces the "do while" loop to do one cycle that will set u1, u2, dh. + ks = 0 + dh = 0. + x_dest = 0. + + ! Find the layer index and fractional position of the interfaces of the target + ! grid on the source grid. + do k_dest=1,ndest+1 + do while (dh<=x_dest .and. ks0.) then + frac_pos(k_dest) = max(0., min(1., x_dest / dh)) ! Weight of u2 + else ! For a vanished source layer we need to do something reasonable... + frac_pos(k_dest) = 0.5 + endif + + if (k_dest <= ndest) then + x_dest = x_dest + h_dest(k_dest) ! Position of interface k_dest+1 + endif + enddo + + do k_dest=1,ndest+1 + ! Linear interpolation between surrounding edge values. + ks = k_src(k_dest) + u_dest(k_dest) = (1.0 - frac_pos(k_dest)) * u_src(ks) + frac_pos(k_dest) * u_src(ks+1) + enddo + + if (mask_edges) then + ! Mask vanished layers at the surface which would be under an ice-shelf. + ! When the layer k_dest is vanished and all layers above are also vanished, + ! the k_dest interface value should be missing. + do k_dest=1,ndest + if (h_dest(k_dest) > 0.) exit + u_dest(k_dest) = 0.0 + enddo + + ! Mask interfaces below vanished layers at the bottom + do k_dest=ndest,1,-1 + if (h_dest(k_dest) > 0.) exit + u_dest(k_dest+1) = 0.0 + enddo + endif + +end subroutine interpolate_column + +!> Conservatively calculate integrated data, uh_dest, on grid h_dest, from layer-integrated data, uh_src, on grid h_src +subroutine reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, uh_dest) + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc), intent(in) :: uh_src !< Values at source cell interfaces [A H] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest), intent(inout) :: uh_dest !< Interpolated value at destination cell interfaces [A H] + + ! Local variables + real :: h_src_rem, h_dest_rem, dh ! Incremental thicknesses [H] + real :: uh_src_rem, duh ! Incremental amounts of stuff [A H] + integer :: k_src, k_dest ! Index of cell in src and dest columns + logical :: src_ran_out + + uh_dest(:) = 0.0 + + k_src = 0 + k_dest = 0 + h_dest_rem = 0. + h_src_rem = 0. + src_ran_out = .false. + + do while(.true.) + if (h_src_rem==0. .and. k_src0.) duh = uh_src_rem + h_src_rem = 0. + uh_src_rem = 0. + h_dest_rem = max(0., h_dest_rem - dh) + elseif (h_src_rem>h_dest_rem) then + ! Only part of the source cell can be used up + dh = h_dest_rem + duh = (dh / h_src_rem) * uh_src_rem + h_src_rem = max(0., h_src_rem - dh) + uh_src_rem = uh_src_rem - duh + h_dest_rem = 0. + else ! h_src_rem==h_dest_rem + ! The source cell exactly fits the destination cell + duh = uh_src_rem + h_src_rem = 0. + uh_src_rem = 0. + h_dest_rem = 0. + endif + uh_dest(k_dest) = uh_dest(k_dest) + duh + if (k_dest==ndest .and. (k_src==nsrc .or. h_dest_rem==0.)) exit + enddo + +end subroutine reintegrate_column + !> Returns the average value of a reconstruction within a single source cell, i0, !! between the non-dimensional positions xa and xb (xa<=xb) with dimensional !! separation dh. real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefs, method, i0, xa, xb) integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: u0(:) !< Cell means - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial + real, intent(in) :: u0(:) !< Cell means [A] + real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial [A] + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial [A] integer, intent(in) :: method !< Remapping scheme to use integer, intent(in) :: i0 !< Source cell index - real, intent(in) :: xa !< Non-dimensional start position within source cell - real, intent(in) :: xb !< Non-dimensional end position within source cell + real, intent(in) :: xa !< Non-dimensional start position within source cell [nondim] + real, intent(in) :: xb !< Non-dimensional end position within source cell [nondim] ! Local variables - real :: u_ave, xa_2, xb_2, xa2pxb2, xapxb - real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials - - real :: mx, a_L, a_R, u_c, Ya, Yb, my, xa2b2ab, Ya2b2ab, a_c + real :: u_ave ! The average value of the polynomial over the specified range [A] + real :: xapxb ! A sum of fracional positions [nondim] + real :: mx, Ya, Yb, my ! Various fractional positions [nondim] + real :: xa_2, xb_2 ! Squared fractional positions [nondim] + real :: xa2pxb2, xa2b2ab, Ya2b2ab ! Sums of squared fractional positions [nondim] + real :: a_L, a_R, u_c, a_c ! Values of the polynomial at various locations [A] + real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials [nondim] if (xb > xa) then select case ( method ) @@ -1082,21 +1098,87 @@ real function average_value_ppoly( n0, u0, ppoly0_E, ppoly0_coefs, method, i0, x end function average_value_ppoly +!> This subroutine checks for sufficient consistence in the extrema and total amounts on the old +!! and new grids. +subroutine check_remapped_values(n0, h0, u0, ppoly_r_E, deg, ppoly_r_coefs, & + n1, h1, u1, iMethod, uh_err, caller) + integer, intent(in) :: n0 !< Number of cells on source grid + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] + real, dimension(n0,2), intent(in) :: ppoly_r_E !< Edge values of polynomial fits [A] + integer, intent(in) :: deg !< Degree of the piecewise polynomial reconstrution + real, dimension(n0,deg+1), intent(in) :: ppoly_r_coefs !< Coefficients of the piecewise + !! polynomial reconstructions [A] + integer, intent(in) :: n1 !< Number of cells on target grid + real, dimension(n1), intent(in) :: h1 !< Cell widths on target grid [H] + real, dimension(n1), intent(in) :: u1 !< Cell averages on target grid [A] + integer, intent(in) :: iMethod !< An integer indicating the integration method used + real, intent(in) :: uh_err !< A bound on the error in the sum of u*h as + !! estimated by the remapping code [H A] + character(len=*), intent(in) :: caller !< The name of the calling routine. + + ! Local variables + real :: h0tot, h0err ! Sum of source cell widths and round-off error in this sum [H] + real :: h1tot, h1err ! Sum of target cell widths and round-off error in this sum [H] + real :: u0tot, u0err ! Integrated values on the source grid and round-off error in this sum [H A] + real :: u1tot, u1err ! Integrated values on the target grid and round-off error in this sum [H A] + real :: u0min, u0max, u1min, u1max ! Extrema of values on the two grids [A] + integer :: k + + ! Check errors and bounds + call measure_input_bounds( n0, h0, u0, ppoly_r_E, h0tot, h0err, u0tot, u0err, u0min, u0max ) + call measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) + + if (iMethod<5) return ! We except PQM until we've debugged it + + if ( (abs(u1tot-u0tot)>(u0err+u1err)+uh_err .and. abs(h1tot-h0tot)u0max) ) then + write(0,*) 'iMethod = ',iMethod + write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + write(0,*) 'U: u0min=',u0min,'u1min=',u1min + if (u1minn0) then + write(0,'(i3,96x,1p2e24.16)') k,h1(k),u1(k) + else + write(0,'(i3,1p4e24.16)') k,h0(k),ppoly_r_E(k,1),u0(k),ppoly_r_E(k,2) + endif + enddo + write(0,'(a3,2a24)') 'k','u0','Polynomial coefficients' + do k = 1, n0 + write(0,'(i3,1p6e24.16)') k,u0(k),ppoly_r_coefs(k,:) + enddo + call MOM_error( FATAL, 'MOM_remapping, '//trim(caller)//': '//& + 'Remapping result is inconsistent!' ) + endif + +end subroutine check_remapped_values + !> Measure totals and bounds on source grid subroutine measure_input_bounds( n0, h0, u0, edge_values, h0tot, h0err, u0tot, u0err, u0min, u0max ) integer, intent(in) :: n0 !< Number of cells on source grid - real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid - real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid - real, dimension(n0,2), intent(in) :: edge_values !< Cell edge values on source grid - real, intent(out) :: h0tot !< Sum of cell widths - real, intent(out) :: h0err !< Magnitude of round-off error in h0tot - real, intent(out) :: u0tot !< Sum of cell widths times values - real, intent(out) :: u0err !< Magnitude of round-off error in u0tot - real, intent(out) :: u0min !< Minimum value in reconstructions of u0 - real, intent(out) :: u0max !< Maximum value in reconstructions of u0 + real, dimension(n0), intent(in) :: h0 !< Cell widths on source grid [H] + real, dimension(n0), intent(in) :: u0 !< Cell averages on source grid [A] + real, dimension(n0,2), intent(in) :: edge_values !< Cell edge values on source grid [A] + real, intent(out) :: h0tot !< Sum of cell widths [H] + real, intent(out) :: h0err !< Magnitude of round-off error in h0tot [H] + real, intent(out) :: u0tot !< Sum of cell widths times values [H A] + real, intent(out) :: u0err !< Magnitude of round-off error in u0tot [H A] + real, intent(out) :: u0min !< Minimum value in reconstructions of u0 [A] + real, intent(out) :: u0max !< Maximum value in reconstructions of u0 [A] ! Local variables + real :: eps ! The smallest representable fraction of a number [nondim] integer :: k - real :: eps eps = epsilon(h0(1)) h0tot = h0(1) @@ -1119,17 +1201,17 @@ end subroutine measure_input_bounds !> Measure totals and bounds on destination grid subroutine measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, u1max ) integer, intent(in) :: n1 !< Number of cells on destination grid - real, dimension(n1), intent(in) :: h1 !< Cell widths on destination grid - real, dimension(n1), intent(in) :: u1 !< Cell averages on destination grid - real, intent(out) :: h1tot !< Sum of cell widths - real, intent(out) :: h1err !< Magnitude of round-off error in h1tot - real, intent(out) :: u1tot !< Sum of cell widths times values - real, intent(out) :: u1err !< Magnitude of round-off error in u1tot - real, intent(out) :: u1min !< Minimum value in reconstructions of u1 - real, intent(out) :: u1max !< Maximum value in reconstructions of u1 + real, dimension(n1), intent(in) :: h1 !< Cell widths on destination grid [H] + real, dimension(n1), intent(in) :: u1 !< Cell averages on destination grid [A] + real, intent(out) :: h1tot !< Sum of cell widths [H] + real, intent(out) :: h1err !< Magnitude of round-off error in h1tot [H] + real, intent(out) :: u1tot !< Sum of cell widths times values [H A] + real, intent(out) :: u1err !< Magnitude of round-off error in u1tot [H A] + real, intent(out) :: u1min !< Minimum value in reconstructions of u1 [A] + real, intent(out) :: u1max !< Maximum value in reconstructions of u1 [A] ! Local variables + real :: eps ! The smallest representable fraction of a number [nondim] integer :: k - real :: eps eps = epsilon(h1(1)) h1tot = h1(1) @@ -1149,444 +1231,16 @@ subroutine measure_output_bounds( n1, h1, u1, h1tot, h1err, u1tot, u1err, u1min, end subroutine measure_output_bounds -!> Remaps column of values u0 on grid h0 to grid h1 by integrating -!! over the projection of each h1 cell onto the h0 grid. -subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n1, h1, method, u1, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, intent(in) :: h0(:) !< Source grid widths (size n0) - real, intent(in) :: u0(:) !< Source cell averages (size n0) - real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial - real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, intent(in) :: h1(:) !< Target grid widths (size n1) - integer, intent(in) :: method !< Remapping scheme to use - real, intent(out) :: u1(:) !< Target cell averages (size n1) - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h. - ! Local variables - integer :: iTarget - real :: xL, xR ! coordinates of target cell edges - integer :: jStart ! Used by integrateReconOnInterval() - real :: xStart ! Used by integrateReconOnInterval() - - ! Loop on cells in target grid (grid1). For each target cell, we need to find - ! in which source cells the target cell edges lie. The associated indexes are - ! noted j0 and j1. - xR = 0. ! Left boundary is at x=0 - jStart = 1 - xStart = 0. - do iTarget = 1,n1 - ! Determine the coordinates of the target cell edges - xL = xR - xR = xL + h1(iTarget) - - call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & - xL, xR, h1(iTarget), u1(iTarget), jStart, xStart, h_neglect ) - - enddo ! end iTarget loop on target grid cells - -end subroutine remapByProjection - - -!> Remaps column of values u0 on grid h0 to implied grid h1 -!! where the interfaces of h1 differ from those of h0 by dx. -!! The new grid is defined relative to the original grid by change -!! dx1(:) = xNew(:) - xOld(:) -!! and the remapping calculated so that -!! hNew(k) qNew(k) = hOld(k) qOld(k) + F(k+1) - F(k) -!! where -!! F(k) = dx1(k) qAverage -!! and where qAverage is the average qOld in the region zOld(k) to zNew(k). -subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, dx1, & - method, u1, h1, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) - real, dimension(:), intent(in) :: u0 !< Source cell averages (size n0) - real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial - real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial - integer, intent(in) :: n1 !< Number of cells in target grid - real, dimension(:), intent(in) :: dx1 !< Target grid edge positions (size n1+1) - integer, intent(in) :: method !< Remapping scheme to use - real, dimension(:), intent(out) :: u1 !< Target cell averages (size n1) - real, dimension(:), & - optional, intent(out) :: h1 !< Target grid widths (size n1) - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h. - ! Local variables - integer :: iTarget - real :: xL, xR ! coordinates of target cell edges - real :: xOld, hOld, uOld - real :: xNew, hNew, h_err - real :: uhNew, hFlux, uAve, fluxL, fluxR - integer :: jStart ! Used by integrateReconOnInterval() - real :: xStart ! Used by integrateReconOnInterval() - - ! Loop on cells in target grid. For each cell, iTarget, the left flux is - ! the right flux of the cell to the left, iTarget-1. - ! The left flux is initialized by started at iTarget=0 to calculate the - ! right flux which can take into account the target left boundary being - ! in the interior of the source domain. - fluxR = 0. - h_err = 0. ! For measuring round-off error - jStart = 1 - xStart = 0. - do iTarget = 0,n1 - fluxL = fluxR ! This does nothing for iTarget=0 - - if (iTarget == 0) then - xOld = 0. ! Left boundary is at x=0 - hOld = -1.E30 ! Should not be used for iTarget = 0 - uOld = -1.E30 ! Should not be used for iTarget = 0 - elseif (iTarget <= n0) then - xOld = xOld + h0(iTarget) ! Position of right edge of cell - hOld = h0(iTarget) - uOld = u0(iTarget) - h_err = h_err + epsilon(hOld) * max(hOld, xOld) - else - hOld = 0. ! as if for layers>n0, they were vanished - uOld = 1.E30 ! and the initial value should not matter - endif - xNew = xOld + dx1(iTarget+1) - xL = min( xOld, xNew ) - xR = max( xOld, xNew ) - - ! hFlux is the positive width of the remapped volume - hFlux = abs(dx1(iTarget+1)) - call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & - xL, xR, hFlux, uAve, jStart, xStart ) - ! uAve is the average value of u, independent of sign of dx1 - fluxR = dx1(iTarget+1)*uAve ! Includes sign of dx1 - - if (iTarget>0) then - hNew = hOld + ( dx1(iTarget+1) - dx1(iTarget) ) - hNew = max( 0., hNew ) - uhNew = ( uOld * hOld ) + ( fluxR - fluxL ) - if (hNew>0.) then - u1(iTarget) = uhNew / hNew - else - u1(iTarget) = uAve - endif - if (present(h1)) h1(iTarget) = hNew - endif - - enddo ! end iTarget loop on target grid cells - -end subroutine remapByDeltaZ - - -!> Integrate the reconstructed column profile over a single cell -subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & - xL, xR, hC, uAve, jStart, xStart, h_neglect ) - integer, intent(in) :: n0 !< Number of cells in source grid - real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) - real, dimension(:), intent(in) :: u0 !< Source cell averages - real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial - real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial - integer, intent(in) :: method !< Remapping scheme to use - real, intent(in) :: xL !< Left edges of target cell - real, intent(in) :: xR !< Right edges of target cell - real, intent(in) :: hC !< Cell width hC = xR - xL - real, intent(out) :: uAve !< Average value on target cell - integer, intent(inout) :: jStart !< The index of the cell to start searching from - !< On exit, contains index of last cell used - real, intent(inout) :: xStart !< The left edge position of cell jStart - !< On first entry should be 0. - real, optional, intent(in) :: h_neglect !< A negligibly small width for the - !! purpose of cell reconstructions - !! in the same units as h. - ! Local variables - integer :: j, k - integer :: jL, jR ! indexes of source cells containing target - ! cell edges - real :: q ! complete integration - real :: xi0, xi1 ! interval of integration (local -- normalized - ! -- coordinates) - real :: x0jLl, x0jLr ! Left/right position of cell jL - real :: x0jRl, x0jRr ! Left/right position of cell jR - real :: hAct ! The distance actually used in the integration - ! (notionally xR - xL) which differs due to roundoff. - real :: x0_2, x1_2, x02px12, x0px1 ! Used in evaluation of integrated polynomials - real :: hNeglect ! A negligible thicness in the same units as h. - real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials - - hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect - - q = -1.E30 - x0jLl = -1.E30 - x0jRl = -1.E30 - - ! Find the left most cell in source grid spanned by the target cell - jL = -1 - x0jLr = xStart - do j = jStart, n0 - x0jLl = x0jLr - x0jLr = x0jLl + h0(j) - ! Left edge is found in cell j - if ( ( xL >= x0jLl ) .AND. ( xL <= x0jLr ) ) then - jL = j - exit ! once target grid cell is found, exit loop - endif - enddo - jStart = jL - xStart = x0jLl - -! ! HACK to handle round-off problems. Need only at j=n0. -! ! This moves the effective cell boundary outwards a smidgen. -! if (xL>x0jLr) x0jLr = xL - - ! If, at this point, jL is equal to -1, it means the vanished - ! cell lies outside the source grid. In other words, it means that - ! the source and target grids do not cover the same physical domain - ! and there is something very wrong ! - if ( jL == -1 ) call MOM_error(FATAL, & - 'MOM_remapping, integrateReconOnInterval: '//& - 'The location of the left-most cell could not be found') - - - ! ============================================================ - ! Check whether target cell is vanished. If it is, the cell - ! average is simply the interpolated value at the location - ! of the vanished cell. If it isn't, we need to integrate the - ! quantity within the cell and divide by the cell width to - ! determine the cell average. - ! ============================================================ - ! 1. Cell is vanished - !if ( abs(xR - xL) <= epsilon(xR)*max(abs(xR),abs(xL)) ) then - if ( abs(xR - xL) == 0.0 ) then - - ! We check whether the source cell (i.e. the cell in which the - ! vanished target cell lies) is vanished. If it is, the interpolated - ! value is set to be mean of the edge values (which should be the same). - ! If it isn't, we simply interpolate. - if ( h0(jL) == 0.0 ) then - uAve = 0.5 * ( ppoly0_E(jL,1) + ppoly0_E(jL,2) ) - else - ! WHY IS THIS NOT WRITTEN AS xi0 = ( xL - x0jLl ) / h0(jL) ---AJA - xi0 = xL / ( h0(jL) + hNeglect ) - x0jLl / ( h0(jL) + hNeglect ) - - select case ( method ) - case ( INTEGRATION_PCM ) - uAve = ppoly0_coefs(jL,1) - case ( INTEGRATION_PLM ) - uAve = ppoly0_coefs(jL,1) & - + xi0 * ppoly0_coefs(jL,2) - case ( INTEGRATION_PPM ) - uAve = ppoly0_coefs(jL,1) & - + xi0 * ( ppoly0_coefs(jL,2) & - + xi0 * ppoly0_coefs(jL,3) ) - case ( INTEGRATION_PQM ) - uAve = ppoly0_coefs(jL,1) & - + xi0 * ( ppoly0_coefs(jL,2) & - + xi0 * ( ppoly0_coefs(jL,3) & - + xi0 * ( ppoly0_coefs(jL,4) & - + xi0 * ppoly0_coefs(jL,5) ) ) ) - case default - call MOM_error( FATAL,'The selected integration method is invalid' ) - end select - - endif ! end checking whether source cell is vanished - - ! 2. Cell is not vanished - else - - ! Find the right most cell in source grid spanned by the target cell - jR = -1 - x0jRr = xStart - do j = jStart,n0 - x0jRl = x0jRr - x0jRr = x0jRl + h0(j) - ! Right edge is found in cell j - if ( ( xR >= x0jRl ) .AND. ( xR <= x0jRr ) ) then - jR = j - exit ! once target grid cell is found, exit loop - endif - enddo ! end loop on source grid cells - - ! If xR>x0jRr then the previous loop reached j=n0 and the target - ! position, xR, was beyond the right edge of the source grid (h0). - ! This can happen due to roundoff, in which case we set jR=n0. - if (xR>x0jRr) jR = n0 - - ! To integrate, two cases must be considered: (1) the target cell is - ! entirely contained within a cell of the source grid and (2) the target - ! cell spans at least two cells of the source grid. - - if ( jL == jR ) then - ! The target cell is entirely contained within a cell of the source - ! grid. This situation is represented by the following schematic, where - ! the cell in which xL and xR are located has index jL=jR : - ! - ! ----|-----o--------o----------|------------- - ! xL xR - ! - ! Determine normalized coordinates -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) - xi1 = max( 0., min( 1., ( xR - x0jLl ) / ( h0(jL) + hNeglect ) ) ) -#else - xi0 = xL / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) - xi1 = xR / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) -#endif - - hAct = h0(jL) * ( xi1 - xi0 ) - - ! Depending on which polynomial is used, integrate quantity - ! between xi0 and xi1. Integration is carried out in normalized - ! coordinates, hence: \int_xL^xR p(x) dx = h \int_xi0^xi1 p(xi) dxi - select case ( method ) - case ( INTEGRATION_PCM ) - q = ( xR - xL ) * ppoly0_coefs(jL,1) - case ( INTEGRATION_PLM ) - q = ( xR - xL ) * ( & - ppoly0_coefs(jL,1) & - + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) - case ( INTEGRATION_PPM ) - q = ( xR - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) - case ( INTEGRATION_PQM ) - x0_2 = xi0*xi0 - x1_2 = xi1*xi1 - x02px12 = x0_2 + x1_2 - x0px1 = xi1 + xi0 - q = ( xR - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) - case default - call MOM_error( FATAL,'The selected integration method is invalid' ) - end select - - else - ! The target cell spans at least two cells of the source grid. - ! This situation is represented by the following schematic, where - ! the cells in which xL and xR are located have indexes jL and jR, - ! respectively : - ! - ! ----|-----o---|--- ... --|---o----------|------------- - ! xL xR - ! - ! We first integrate from xL up to the right boundary of cell jL, then - ! add the integrated amounts of cells located between jL and jR and then - ! integrate from the left boundary of cell jR up to xR - - q = 0.0 - - ! Integrate from xL up to right boundary of cell jL -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) -#else - xi0 = (xL - x0jLl) / ( h0(jL) + hNeglect ) -#endif - xi1 = 1.0 - - hAct = h0(jL) * ( xi1 - xi0 ) - - select case ( method ) - case ( INTEGRATION_PCM ) - q = q + ( x0jLr - xL ) * ppoly0_coefs(jL,1) - case ( INTEGRATION_PLM ) - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefs(jL,1) & - + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) - case ( INTEGRATION_PPM ) - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) - case ( INTEGRATION_PQM ) - x0_2 = xi0*xi0 - x1_2 = xi1*xi1 - x02px12 = x0_2 + x1_2 - x0px1 = xi1 + xi0 - q = q + ( x0jLr - xL ) * ( & - ppoly0_coefs(jL,1) & - + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) - case default - call MOM_error( FATAL, 'The selected integration method is invalid' ) - end select - - ! Integrate contents within cells strictly comprised between jL and jR - if ( jR > (jL+1) ) then - do k = jL+1,jR-1 - q = q + h0(k) * u0(k) - hAct = hAct + h0(k) - enddo - endif - - ! Integrate from left boundary of cell jR up to xR - xi0 = 0.0 -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ - xi1 = max( 0., min( 1., ( xR - x0jRl ) / ( h0(jR) + hNeglect ) ) ) -#else - xi1 = (xR - x0jRl) / ( h0(jR) + hNeglect ) -#endif - - hAct = hAct + h0(jR) * ( xi1 - xi0 ) - - select case ( method ) - case ( INTEGRATION_PCM ) - q = q + ( xR - x0jRl ) * ppoly0_coefs(jR,1) - case ( INTEGRATION_PLM ) - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefs(jR,1) & - + ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) ) - case ( INTEGRATION_PPM ) - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefs(jR,1) & - + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & - + ppoly0_coefs(jR,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) - case ( INTEGRATION_PQM ) - x0_2 = xi0*xi0 - x1_2 = xi1*xi1 - x02px12 = x0_2 + x1_2 - x0px1 = xi1 + xi0 - q = q + ( xR - x0jRl ) * ( & - ppoly0_coefs(jR,1) & - + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & - + ( ppoly0_coefs(jR,3) * r_3 * ( x02px12 + xi0*xi1 ) & - + ppoly0_coefs(jR,4) * 0.25* ( x02px12 * x0px1 ) & - + ppoly0_coefs(jR,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) - case default - call MOM_error( FATAL,'The selected integration method is invalid' ) - end select - - endif ! end integration for non-vanished cells - - ! The cell average is the integrated value divided by the cell width -#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ -if (hAct==0.) then - uAve = ppoly0_coefs(jL,1) -else - uAve = q / hAct -endif -#else - uAve = q / hC -#endif - - endif ! endif clause to check if cell is vanished - -end subroutine integrateReconOnInterval - !> Calculates the change in interface positions based on h1 and h2 subroutine dzFromH1H2( n1, h1, n2, h2, dx ) integer, intent(in) :: n1 !< Number of cells on source grid - real, dimension(:), intent(in) :: h1 !< Cell widths of source grid (size n1) + real, dimension(:), intent(in) :: h1 !< Cell widths of source grid (size n1) [H] integer, intent(in) :: n2 !< Number of cells on target grid - real, dimension(:), intent(in) :: h2 !< Cell widths of target grid (size n2) - real, dimension(:), intent(out) :: dx !< Change in interface position (size n2+1) + real, dimension(:), intent(in) :: h2 !< Cell widths of target grid (size n2) [H] + real, dimension(:), intent(out) :: dx !< Change in interface position (size n2+1) [H] ! Local variables integer :: k - real :: x1, x2 + real :: x1, x2 ! Interface positions [H] x1 = 0. x2 = 0. @@ -1611,7 +1265,7 @@ subroutine initialize_remapping( CS, remapping_scheme, boundary_extrapolation, & logical, optional, intent(in) :: check_reconstruction !< Indicate to check reconstructions logical, optional, intent(in) :: check_remapping !< Indicate to check results of remapping logical, optional, intent(in) :: force_bounds_in_subcell !< Force subcells values to be bounded - logical, optional, intent(in) :: answers_2018 !< If true use older, less acccurate expressions. + logical, optional, intent(in) :: answers_2018 !< If true use older, less accurate expressions. integer, optional, intent(in) :: answer_date !< The vintage of the expressions to use ! Note that remapping_scheme is mandatory for initialize_remapping() @@ -1641,6 +1295,9 @@ subroutine setReconstructionType(string,CS) case ("PLM_HYBGEN") CS%remapping_scheme = REMAPPING_PLM_HYBGEN degree = 1 + case ("PPM_CW") + CS%remapping_scheme = REMAPPING_PPM_CW + degree = 2 case ("PPM_H4") CS%remapping_scheme = REMAPPING_PPM_H4 degree = 2 @@ -1683,19 +1340,27 @@ logical function remapping_unit_tests(verbose) logical, intent(in) :: verbose !< If true, write results to stdout ! Local variables integer, parameter :: n0 = 4, n1 = 3, n2 = 6 - real :: h0(n0), x0(n0+1), u0(n0) - real :: h1(n1), x1(n1+1), u1(n1), hn1(n1), dx1(n1+1) - real :: h2(n2), x2(n2+1), u2(n2), hn2(n2), dx2(n2+1) - data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom - data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 - data h1 /3*1./ ! 3 uniform layers with total depth of 3 - data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 + real :: h0(n0), x0(n0+1), u0(n0) ! Thicknesses [H], interface heights [H] and values [A] for profile 0 + real :: h1(n1), x1(n1+1), u1(n1) ! Thicknesses [H], interface heights [H] and values [A] for profile 1 + real :: dx1(n1+1) ! Interface height changes for profile 1 [H] + real :: h2(n2), x2(n2+1), u2(n2) ! Thicknesses [H], interface heights [H] and values [A] for profile 2 + data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom [A] + data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 [H] + data h1 /3*1./ ! 3 uniform layers with total depth of 3 [H] + data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 [H] type(remapping_CS) :: CS !< Remapping control structure - real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs + real, allocatable, dimension(:,:) :: ppoly0_E ! Edge values of polynomials [A] + real, allocatable, dimension(:,:) :: ppoly0_S ! Edge slopes of polynomials [A H-1] + real, allocatable, dimension(:,:) :: ppoly0_coefs ! Coefficients of polynomials [A] integer :: answer_date ! The vintage of the expressions to test integer :: i - real :: err, h_neglect, h_neglect_edge - logical :: thisTest, v + real, parameter :: hNeglect_dflt = 1.0e-30 ! A thickness [H ~> m or kg m-2] that can be + ! added to thicknesses in a denominator without + ! changing the numerical result, except where + ! a division by zero would otherwise occur. + real :: err ! Errors in the remapped thicknesses [H] or values [A] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H] + logical :: thisTest, v, fail v = verbose answer_date = 20190101 ! 20181231 @@ -1749,49 +1414,9 @@ logical function remapping_unit_tests(verbose) call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10, answer_date=answer_date ) call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=answer_date ) call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) - u1(:) = 0. - call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n1, h1, INTEGRATION_PPM, u1, h_neglect ) - do i=1,n1 - err=u1(i)-8.*(0.5*real(1+n1)-real(i)) - if (abs(err)>2.*epsilon(err)) thisTest = .true. - enddo - if (thisTest) write(stdout,*) 'remapping_unit_tests: Failed remapByProjection()' - remapping_unit_tests = remapping_unit_tests .or. thisTest - - thisTest = .false. - u1(:) = 0. - call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n1, x1-x0(1:n1+1), & - INTEGRATION_PPM, u1, hn1, h_neglect ) - if (verbose) write(stdout,*) 'h1 (by delta)' - if (verbose) call dumpGrid(n1,h1,x1,u1) - hn1=hn1-h1 - do i=1,n1 - err=u1(i)-8.*(0.5*real(1+n1)-real(i)) - if (abs(err)>2.*epsilon(err)) thisTest = .true. - enddo - if (thisTest) write(stdout,*) 'remapping_unit_tests: Failed remapByDeltaZ() 1' - remapping_unit_tests = remapping_unit_tests .or. thisTest thisTest = .false. call buildGridFromH(n2, h2, x2) - dx2(1:n0+1) = x2(1:n0+1) - x0 - dx2(n0+2:n2+1) = x2(n0+2:n2+1) - x0(n0+1) - call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & - n2, dx2, & - INTEGRATION_PPM, u2, hn2, h_neglect ) - if (verbose) write(stdout,*) 'h2' - if (verbose) call dumpGrid(n2,h2,x2,u2) - if (verbose) write(stdout,*) 'hn2' - if (verbose) call dumpGrid(n2,hn2,x2,u2) - - do i=1,n2 - err=u2(i)-8./2.*(0.5*real(1+n2)-real(i)) - if (abs(err)>2.*epsilon(err)) thisTest = .true. - enddo - if (thisTest) write(stdout,*) 'remapping_unit_tests: Failed remapByDeltaZ() 2' - remapping_unit_tests = remapping_unit_tests .or. thisTest if (verbose) write(stdout,*) 'Via sub-cells' thisTest = .false. @@ -1945,6 +1570,111 @@ logical function remapping_unit_tests(verbose) deallocate(ppoly0_E, ppoly0_S, ppoly0_coefs) + ! This line carries out tests on some older remapping schemes. + remapping_unit_tests = remapping_unit_tests .or. remapping_attic_unit_tests(verbose) + + if (.not. remapping_unit_tests) write(stdout,*) 'Pass' + + write(stdout,*) '=== MOM_remapping: interpolation and reintegration unit tests ===' + if (verbose) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' + + fail = test_interp(verbose, 'Identity: 3 layer', & + 3, (/1.,2.,3./), (/1.,2.,3.,4./), & + 3, (/1.,2.,3./), (/1.,2.,3.,4./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'A: 3 layer to 2', & + 3, (/1.,1.,1./), (/1.,2.,3.,4./), & + 2, (/1.5,1.5/), (/1.,2.5,4./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'B: 2 layer to 3', & + 2, (/1.5,1.5/), (/1.,4.,7./), & + 3, (/1.,1.,1./), (/1.,3.,5.,7./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'C: 3 layer (vanished middle) to 2', & + 3, (/1.,0.,2./), (/1.,2.,2.,3./), & + 2, (/1.,2./), (/1.,2.,3./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'D: 3 layer (deep) to 3', & + 3, (/1.,2.,3./), (/1.,2.,4.,7./), & + 2, (/2.,2./), (/1.,3.,5./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'E: 3 layer to 3 (deep)', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 3, (/2.,3.,4./), (/1.,3.,6.,8./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'F: 3 layer to 4 with vanished top/botton', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 4, (/0.,2.,5.,0./), (/0.,1.,3.,8.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'Fs: 3 layer to 4 with vanished top/botton (shallow)', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 4, (/0.,2.,4.,0./), (/0.,1.,3.,7.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_interp(verbose, 'Fd: 3 layer to 4 with vanished top/botton (deep)', & + 3, (/1.,2.,4./), (/1.,2.,4.,8./), & + 4, (/0.,2.,6.,0./), (/0.,1.,3.,8.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + if (verbose) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' + + fail = test_reintegrate(verbose, 'Identity: 3 layer', & + 3, (/1.,2.,3./), (/-5.,2.,1./), & + 3, (/1.,2.,3./), (/-5.,2.,1./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'A: 3 layer to 2', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 2, (/3.,3./), (/-4.,2./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'A: 3 layer to 2 (deep)', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 2, (/3.,4./), (/-4.,2./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'A: 3 layer to 2 (shallow)', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 2, (/3.,2./), (/-4.,1.5/) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'B: 3 layer to 4 with vanished top/bottom', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 4, (/0.,3.,3.,0./), (/0.,-4.,2.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'C: 3 layer to 4 with vanished top//middle/bottom', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 5, (/0.,3.,0.,3.,0./), (/0.,-4.,0.,2.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'D: 3 layer to 3 (vanished)', & + 3, (/2.,2.,2./), (/-5.,2.,1./), & + 3, (/0.,0.,0./), (/0.,0.,0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'D: 3 layer (vanished) to 3', & + 3, (/0.,0.,0./), (/-5.,2.,1./), & + 3, (/2.,2.,2./), (/0., 0., 0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'D: 3 layer (vanished) to 3 (vanished)', & + 3, (/0.,0.,0./), (/-5.,2.,1./), & + 3, (/0.,0.,0./), (/0., 0., 0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + + fail = test_reintegrate(verbose, 'D: 3 layer (vanished) to 3 (vanished)', & + 3, (/0.,0.,0./), (/0.,0.,0./), & + 3, (/0.,0.,0./), (/0., 0., 0./) ) + remapping_unit_tests = remapping_unit_tests .or. fail + if (.not. remapping_unit_tests) write(stdout,*) 'Pass' end function remapping_unit_tests @@ -1953,12 +1683,12 @@ end function remapping_unit_tests logical function test_answer(verbose, n, u, u_true, label, tol) logical, intent(in) :: verbose !< If true, write results to stdout integer, intent(in) :: n !< Number of cells in u - real, dimension(n), intent(in) :: u !< Values to test - real, dimension(n), intent(in) :: u_true !< Values to test against (correct answer) + real, dimension(n), intent(in) :: u !< Values to test [A] + real, dimension(n), intent(in) :: u_true !< Values to test against (correct answer) [A] character(len=*), intent(in) :: label !< Message - real, optional, intent(in) :: tol !< The tolerance for differences between u and u_true + real, optional, intent(in) :: tol !< The tolerance for differences between u and u_true [A] ! Local variables - real :: tolerance ! The tolerance for differences between u and u_true + real :: tolerance ! The tolerance for differences between u and u_true [A] integer :: k tolerance = 0.0 ; if (present(tol)) tolerance = tol @@ -1980,12 +1710,86 @@ logical function test_answer(verbose, n, u, u_true, label, tol) end function test_answer +!> Returns true if a test of interpolate_column() produces the wrong answer +logical function test_interp(verbose, msg, nsrc, h_src, u_src, ndest, h_dest, u_true) + logical, intent(in) :: verbose !< If true, write results to stdout + character(len=*), intent(in) :: msg !< Message to label test + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces [A] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest+1), intent(in) :: u_true !< Correct value at destination cell interfaces [A] + ! Local variables + real, dimension(ndest+1) :: u_dest ! Interpolated value at destination cell interfaces [A] + integer :: k + real :: error + + ! Interpolate from src to dest + call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, u_dest, .true.) + + test_interp = .false. + do k=1,ndest+1 + if (u_dest(k)/=u_true(k)) test_interp = .true. + enddo + if (verbose .or. test_interp) then + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','u_result','u_true','error' + do k=1,ndest+1 + error = u_dest(k)-u_true(k) + if (error==0.) then + write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) + else + write(stdout,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + endif + enddo + endif +end function test_interp + +!> Returns true if a test of reintegrate_column() produces the wrong answer +logical function test_reintegrate(verbose, msg, nsrc, h_src, uh_src, ndest, h_dest, uh_true) + logical, intent(in) :: verbose !< If true, write results to stdout + character(len=*), intent(in) :: msg !< Message to label test + integer, intent(in) :: nsrc !< Number of source cells + real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells [H] + real, dimension(nsrc), intent(in) :: uh_src !< Values of source cell stuff [A H] + integer, intent(in) :: ndest !< Number of destination cells + real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells [H] + real, dimension(ndest), intent(in) :: uh_true !< Correct value of destination cell stuff [A H] + ! Local variables + real, dimension(ndest) :: uh_dest ! Reintegrated value on destination cells [A H] + integer :: k + real :: error + + ! Interpolate from src to dest + call reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, uh_dest) + + test_reintegrate = .false. + do k=1,ndest + if (uh_dest(k)/=uh_true(k)) test_reintegrate = .true. + enddo + if (verbose .or. test_reintegrate) then + write(stdout,'(2a)') ' Test: ',msg + write(stdout,'(a3,3(a24))') 'k','uh_result','uh_true','error' + do k=1,ndest + error = uh_dest(k)-uh_true(k) + if (error==0.) then + write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) + else + write(stdout,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + endif + enddo + endif +end function test_reintegrate + !> Convenience function for printing grid to screen subroutine dumpGrid(n,h,x,u) integer, intent(in) :: n !< Number of cells - real, dimension(:), intent(in) :: h !< Cell thickness - real, dimension(:), intent(in) :: x !< Interface delta - real, dimension(:), intent(in) :: u !< Cell average values + real, dimension(:), intent(in) :: h !< Cell thickness [H] + real, dimension(:), intent(in) :: x !< Interface delta [H] + real, dimension(:), intent(in) :: u !< Cell average values [A] integer :: i write(stdout,'("i=",20i10)') (i,i=1,n+1) write(stdout,'("x=",20es10.2)') (x(i),i=1,n+1) diff --git a/src/ALE/PPM_functions.F90 b/src/ALE/PPM_functions.F90 index aa24806d68..805a70d502 100644 --- a/src/ALE/PPM_functions.F90 +++ b/src/ALE/PPM_functions.F90 @@ -13,7 +13,7 @@ module PPM_functions implicit none ; private -public PPM_reconstruction, PPM_boundary_extrapolation +public PPM_reconstruction, PPM_boundary_extrapolation, PPM_monotonicity !> A tiny width that is so small that adding it to cell widths does not !! change the value due to a computational representation. It is used @@ -127,6 +127,35 @@ subroutine PPM_limiter_standard( N, h, u, edge_values, h_neglect, answer_date ) end subroutine PPM_limiter_standard +!> Adjusts edge values using the original monotonicity constraint (Colella & Woodward, JCP 1984) +!! Based on hybgen_ppm_coefs +subroutine PPM_monotonicity( N, u, edge_values ) + integer, intent(in) :: N !< Number of cells + real, dimension(:), intent(in) :: u !< cell average properties (size N) [A] + real, dimension(:,:), intent(inout) :: edge_values !< Potentially modified edge values [A] + + ! Local variables + integer :: k ! Loop index + real :: a6,da ! scalar temporaries + + ! Loop on interior cells to impose monotonicity + ! Eq. 1.10 of (Colella & Woodward, JCP 84) + do k = 2,N-1 + if (((u(k+1)-u(k))*(u(k)-u(k-1)) <= 0.)) then !local extremum + edge_values(k,1) = u(k) + edge_values(k,2) = u(k) + else + da = edge_values(k,2)-edge_values(k,1) + a6 = 6.0*u(k) - 3.0*(edge_values(k,1)+edge_values(k,2)) + if (da*a6 > da*da) then !peak in right half of zone + edge_values(k,1) = 3.0*u(k) - 2.0*edge_values(k,2) + elseif (da*a6 < -da*da) then !peak in left half of zone + edge_values(k,2) = 3.0*u(k) - 2.0*edge_values(k,1) + endif + endif + enddo ! end loop on interior cells + +end subroutine PPM_monotonicity !------------------------------------------------------------------------------ !> Reconstruction by parabolas within boundary cells diff --git a/src/ALE/coord_hycom.F90 b/src/ALE/coord_hycom.F90 index 5a3ffaff52..aa2715eb42 100644 --- a/src/ALE/coord_hycom.F90 +++ b/src/ALE/coord_hycom.F90 @@ -4,8 +4,10 @@ module coord_hycom ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL +use MOM_remapping, only : remapping_CS, remapping_core_h use MOM_EOS, only : EOS_type, calculate_density -use regrid_interp, only : interp_CS_type, build_and_interpolate_grid +use regrid_interp, only : interp_CS_type, build_and_interpolate_grid, regridding_set_ppolys +use regrid_interp, only : DEGREE_MAX implicit none ; private @@ -27,6 +29,9 @@ module coord_hycom !> Maximum thicknesses of layers [H ~> m or kg m-2] real, allocatable, dimension(:) :: max_layer_thickness + !> If true, an interface only moves if it improves the density fit + logical :: only_improves = .false. + !> Interpolation control structure type(interp_CS_type) :: interp_CS end type hycom_CS @@ -69,10 +74,11 @@ subroutine end_coord_hycom(CS) end subroutine end_coord_hycom !> This subroutine can be used to set the parameters for the coord_hycom module -subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, interp_CS) +subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, only_improves, interp_CS) type(hycom_CS), pointer :: CS !< Coordinate control structure real, dimension(:), optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] real, dimension(:), optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] + logical, optional, intent(in) :: only_improves !< If true, an interface only moves if it improves the density fit type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation if (.not. associated(CS)) call MOM_error(FATAL, "set_hycom_params: CS not associated") @@ -91,13 +97,16 @@ subroutine set_hycom_params(CS, max_interface_depths, max_layer_thickness, inter CS%max_layer_thickness(:) = max_layer_thickness(:) endif + if (present(only_improves)) CS%only_improves = only_improves + if (present(interp_CS)) CS%interp_CS = interp_CS end subroutine set_hycom_params !> Build a HyCOM coordinate column -subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & +subroutine build_hycom1_column(CS, remapCS, eqn_of_state, nz, depth, h, T, S, p_col, & z_col, z_col_new, zScale, h_neglect, h_neglect_edge) type(hycom_CS), intent(in) :: CS !< Coordinate control structure + type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure integer, intent(in) :: nz !< Number of levels real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) @@ -116,8 +125,17 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & ! Local variables integer :: k - real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] - real, dimension(CS%nk) :: h_col_new ! New layer thicknesses + real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] + real, dimension(CS%nk) :: h_col_new ! New layer thicknesses [H ~> m or kg m-2] + real, dimension(CS%nk) :: r_col_new ! New layer densities [R ~> kg m-3] + real, dimension(CS%nk) :: T_col_new ! New layer temperatures [C ~> degC] + real, dimension(CS%nk) :: S_col_new ! New layer salinities [S ~> ppt] + real, dimension(CS%nk) :: p_col_new ! New layer pressure [R L2 T-2 ~> Pa] + real, dimension(CS%nk+1) :: RiA_ini ! Initial nk+1 interface density anomaly w.r.t. the + ! interface target densities [R ~> kg m-3] + real, dimension(CS%nk+1) :: RiA_new ! New interface density anomaly w.r.t. the + ! interface target densities [R ~> kg m-3] + real :: z_1, z_nz ! mid point of 1st and last layers [H ~> m or kg m-2] real :: z_scale ! A scaling factor from the input thicknesses to the target thicknesses, ! perhaps 1 or a factor in [H Z-1 ~> 1 or kg m-3] real :: stretching ! z* stretching, converts z* to z [nondim]. @@ -130,18 +148,43 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & z_scale = 1.0 ; if (present(zScale)) z_scale = zScale - ! Work bottom recording potential density - call calculate_density(T, S, p_col, rho_col, eqn_of_state) - ! This ensures the potential density profile is monotonic - ! although not necessarily single valued. - do k = nz-1, 1, -1 - rho_col(k) = min( rho_col(k), rho_col(k+1) ) - enddo + if (CS%only_improves .and. nz == CS%nk) then + call build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, CS%nk, depth, & + h, T, S, p_col, rho_col, RiA_ini, h_neglect, h_neglect_edge) + else + ! Work bottom recording potential density + call calculate_density(T, S, p_col, rho_col, eqn_of_state) + ! This ensures the potential density profile is monotonic + ! although not necessarily single valued. + do k = nz-1, 1, -1 + rho_col(k) = min( rho_col(k), rho_col(k+1) ) + enddo + endif ! Interpolates for the target interface position with the rho_col profile ! Based on global density profile, interpolate to generate a new grid call build_and_interpolate_grid(CS%interp_CS, rho_col, nz, h(:), z_col, & CS%target_density, CS%nk, h_col_new, z_col_new, h_neglect, h_neglect_edge) + if (CS%only_improves .and. nz == CS%nk) then + ! Only move an interface if it improves the density fit + z_1 = 0.5 * ( z_col(1) + z_col(2) ) + z_nz = 0.5 * ( z_col(nz) + z_col(nz+1) ) + do k = 1,CS%nk + p_col_new(k) = p_col(1) + ( 0.5 * ( z_col_new(K) + z_col_new(K+1) ) - z_1 ) / ( z_nz - z_1 ) * & + ( p_col(nz) - p_col(1) ) + enddo + ! Remap from original h and T,S to get T,S_col_new + call remapping_core_h(remapCS, nz, h(:), T, CS%nk, h_col_new, T_col_new, h_neglect, h_neglect_edge) + call remapping_core_h(remapCS, nz, h(:), S, CS%nk, h_col_new, S_col_new, h_neglect, h_neglect_edge) + call build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, CS%nk, depth, & + h_col_new, T_col_new, S_col_new, p_col_new, r_col_new, RiA_new, h_neglect, h_neglect_edge) + do k= 2,CS%nk + if ( abs(RiA_ini(K)) <= abs(RiA_new(K)) .and. z_col(K) > z_col_new(K-1) .and. & + z_col(K) < z_col_new(K+1)) then + z_col_new(K) = z_col(K) + endif + enddo + endif !only_improves ! Sweep down the interfaces and make sure that the interface is at least ! as deep as a nominal target z* grid @@ -165,4 +208,59 @@ subroutine build_hycom1_column(CS, eqn_of_state, nz, depth, h, T, S, p_col, & enddo ; endif end subroutine build_hycom1_column +!> Calculate interface density anomaly w.r.t. the target. +subroutine build_hycom1_target_anomaly(CS, remapCS, eqn_of_state, nz, depth, h, T, S, p_col, & + R, RiAnom, h_neglect, h_neglect_edge) + type(hycom_CS), intent(in) :: CS !< Coordinate control structure + type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options + type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure + integer, intent(in) :: nz !< Number of levels + real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) + real, dimension(nz), intent(in) :: T !< Temperature of column [C ~> degC] + real, dimension(nz), intent(in) :: S !< Salinity of column [S ~> ppt] + real, dimension(nz), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(nz), intent(in) :: p_col !< Layer pressure [R L2 T-2 ~> Pa] + !! to desired units for zInterface, perhaps GV%Z_to_H. + real, dimension(nz), intent(out) :: R !< Layer density [R ~> kg m-3] + real, dimension(nz+1), intent(out) :: RiAnom !< The interface density anomaly + !! w.r.t. the interface target + !! densities [R ~> kg m-3] + real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of + !! cell reconstruction [H ~> m or kg m-2] + real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose of + !! edge value calculation [H ~> m or kg m-2] + ! Local variables + integer :: degree,k + real, dimension(nz) :: rho_col ! Layer densities in a column [R ~> kg m-3] + real, dimension(nz,2) :: ppoly_E ! Polynomial edge values [R ~> kg m-3] + real, dimension(nz,2) :: ppoly_S ! Polynomial edge slopes [R H-1] + real, dimension(nz,DEGREE_MAX+1) :: ppoly_C ! Polynomial interpolant coeficients on the local 0-1 grid [R ~> kg m-3] + + ! Work bottom recording potential density + call calculate_density(T, S, p_col, rho_col, eqn_of_state) + ! This ensures the potential density profile is monotonic + ! although not necessarily single valued. + do k = nz-1, 1, -1 + rho_col(k) = min( rho_col(k), rho_col(k+1) ) + enddo + + call regridding_set_ppolys(CS%interp_CS, rho_col, nz, h, ppoly_E, ppoly_S, ppoly_C, & + degree, h_neglect, h_neglect_edge) + + R(1) = rho_col(1) + RiAnom(1) = ppoly_E(1,1) - CS%target_density(1) + do k= 2,nz + R(k) = rho_col(k) + if (ppoly_E(k-1,2) > CS%target_density(k)) then + RiAnom(k) = ppoly_E(k-1,2) - CS%target_density(k) !interface is heavier than target + elseif (ppoly_E(k,1) < CS%target_density(k)) then + RiAnom(k) = ppoly_E(k,1) - CS%target_density(k) !interface is lighter than target + else + RiAnom(k) = 0.0 !interface spans the target + endif + enddo + RiAnom(nz+1) = ppoly_E(nz,2) - CS%target_density(nz+1) + +end subroutine build_hycom1_target_anomaly + end module coord_hycom diff --git a/src/ALE/coord_rho.F90 b/src/ALE/coord_rho.F90 index 0cbf025b94..8454c4be1d 100644 --- a/src/ALE/coord_rho.F90 +++ b/src/ALE/coord_rho.F90 @@ -67,12 +67,14 @@ subroutine end_coord_rho(CS) end subroutine end_coord_rho !> This subroutine can be used to set the parameters for the coord_rho module -subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS) +subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS, ref_pressure) type(rho_CS), pointer :: CS !< Coordinate control structure real, optional, intent(in) :: min_thickness !< Minimum allowed thickness [H ~> m or kg m-2] logical, optional, intent(in) :: integrate_downward_for_e !< If true, integrate for interface !! positions from the top downward. If false, integrate !! from the bottom upward, as does the rest of the model. + real, optional, intent(in) :: ref_pressure !< The reference pressure for density-dependent + !! coordinates [R L2 T-2 ~> Pa] type(interp_CS_type), optional, intent(in) :: interp_CS !< Controls for interpolation @@ -81,6 +83,7 @@ subroutine set_rho_params(CS, min_thickness, integrate_downward_for_e, interp_CS if (present(min_thickness)) CS%min_thickness = min_thickness if (present(integrate_downward_for_e)) CS%integrate_downward_for_e = integrate_downward_for_e if (present(interp_CS)) CS%interp_CS = interp_CS + if (present(ref_pressure)) CS%ref_pressure = ref_pressure end subroutine set_rho_params !> Build a rho coordinate column diff --git a/src/ALE/coord_slight.F90 b/src/ALE/coord_slight.F90 deleted file mode 100644 index 4b4ac8a153..0000000000 --- a/src/ALE/coord_slight.F90 +++ /dev/null @@ -1,733 +0,0 @@ -!> Regrid columns for the SLight coordinate -module coord_slight - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL -use MOM_EOS, only : EOS_type, calculate_compress -use MOM_EOS, only : calculate_density, calculate_density_derivs -use regrid_interp, only : interp_CS_type, regridding_set_ppolys -use regrid_interp, only : NR_ITERATIONS, NR_TOLERANCE, DEGREE_MAX - -implicit none ; private - -!> Control structure containing required parameters for the SLight coordinate -type, public :: slight_CS ; private - - !> Number of layers/levels - integer :: nk - - !> Minimum thickness allowed when building the new grid through regridding [H ~> m or kg m-2] - real :: min_thickness - - !> Reference pressure for potential density calculations [R L2 T-2 ~> Pa] - real :: ref_pressure - - !> Fraction (between 0 and 1) of compressibility to add to potential density - !! profiles when interpolating for target grid positions. [nondim] - real :: compressibility_fraction - - ! The following 4 parameters were introduced for use with the SLight coordinate: - !> Depth over which to average to determine the mixed layer potential density [H ~> m or kg m-2] - real :: Rho_ML_avg_depth - - !> Number of layers to offset the mixed layer density to find resolved stratification [nondim] - real :: nlay_ml_offset - - !> The number of fixed-thickness layers at the top of the model - integer :: nz_fixed_surface = 2 - - !> The fixed resolution in the topmost SLight_nkml_min layers [H ~> m or kg m-2] - real :: dz_ml_min - - !> If true, detect regions with much weaker stratification in the coordinate - !! than based on in-situ density, and use a stretched coordinate there. - logical :: fix_haloclines = .false. - - !> A length scale over which to filter T & S when looking for spuriously - !! unstable water mass profiles [H ~> m or kg m-2]. - real :: halocline_filter_length - - !> A value of the stratification ratio that defines a problematic halocline region [nondim]. - real :: halocline_strat_tol - - !> Nominal density of interfaces [R ~> kg m-3]. - real, allocatable, dimension(:) :: target_density - - !> Maximum depths of interfaces [H ~> m or kg m-2]. - real, allocatable, dimension(:) :: max_interface_depths - - !> Maximum thicknesses of layers [H ~> m or kg m-2]. - real, allocatable, dimension(:) :: max_layer_thickness - - !> Interpolation control structure - type(interp_CS_type) :: interp_CS -end type slight_CS - -public init_coord_slight, set_slight_params, build_slight_column, end_coord_slight - -contains - -!> Initialise a slight_CS with pointers to parameters -subroutine init_coord_slight(CS, nk, ref_pressure, target_density, interp_CS, m_to_H) - type(slight_CS), pointer :: CS !< Unassociated pointer to hold the control structure - integer, intent(in) :: nk !< Number of layers in the grid - real, intent(in) :: ref_pressure !< Coordinate reference pressure [R L2 T-2 ~> Pa] - real, dimension(:), intent(in) :: target_density !< Nominal density of interfaces [R ~> kg m-3] - type(interp_CS_type), intent(in) :: interp_CS !< Controls for interpolation - real, optional, intent(in) :: m_to_H !< A conversion factor from m to the units of thicknesses - - real :: m_to_H_rescale ! A unit conversion factor. - - if (associated(CS)) call MOM_error(FATAL, "init_coord_slight: CS already associated!") - allocate(CS) - allocate(CS%target_density(nk+1)) - - m_to_H_rescale = 1.0 ; if (present(m_to_H)) m_to_H_rescale = m_to_H - - CS%nk = nk - CS%ref_pressure = ref_pressure - CS%target_density(:) = target_density(:) - CS%interp_CS = interp_CS - - ! Set real parameter default values - CS%compressibility_fraction = 0. ! Nondim. - CS%Rho_ML_avg_depth = 1.0 * m_to_H_rescale - CS%nlay_ml_offset = 2.0 ! Nondim. - CS%dz_ml_min = 1.0 * m_to_H_rescale - CS%halocline_filter_length = 2.0 * m_to_H_rescale - CS%halocline_strat_tol = 0.25 ! Nondim. - -end subroutine init_coord_slight - -!> This subroutine deallocates memory in the control structure for the coord_slight module -subroutine end_coord_slight(CS) - type(slight_CS), pointer :: CS !< Coordinate control structure - - ! nothing to do - if (.not. associated(CS)) return - deallocate(CS%target_density) - deallocate(CS) -end subroutine end_coord_slight - -!> This subroutine can be used to set the parameters for the coord_slight module -subroutine set_slight_params(CS, max_interface_depths, max_layer_thickness, & - min_thickness, compressibility_fraction, dz_ml_min, & - nz_fixed_surface, Rho_ML_avg_depth, nlay_ML_offset, fix_haloclines, & - halocline_filter_length, halocline_strat_tol, interp_CS) - type(slight_CS), pointer :: CS !< Coordinate control structure - real, dimension(:), & - optional, intent(in) :: max_interface_depths !< Maximum depths of interfaces [H ~> m or kg m-2] - real, dimension(:), & - optional, intent(in) :: max_layer_thickness !< Maximum thicknesses of layers [H ~> m or kg m-2] - real, optional, intent(in) :: min_thickness !< Minimum thickness allowed when building the - !! new grid through regridding [H ~> m or kg m-2] - real, optional, intent(in) :: compressibility_fraction !< Fraction (between 0 and 1) of - !! compressibility to add to potential density profiles when - !! interpolating for target grid positions. [nondim] - real, optional, intent(in) :: dz_ml_min !< The fixed resolution in the topmost - !! SLight_nkml_min layers [H ~> m or kg m-2] - integer, optional, intent(in) :: nz_fixed_surface !< The number of fixed-thickness layers at the - !! top of the model - real, optional, intent(in) :: Rho_ML_avg_depth !< Depth over which to average to determine - !! the mixed layer potential density [H ~> m or kg m-2] - real, optional, intent(in) :: nlay_ML_offset !< Number of layers to offset the mixed layer - !! density to find resolved stratification [nondim] - logical, optional, intent(in) :: fix_haloclines !< If true, detect regions with much weaker than - !! based on in-situ density, and use a stretched coordinate there. - real, optional, intent(in) :: halocline_filter_length !< A length scale over which to filter T & S - !! when looking for spuriously unstable water mass profiles [H ~> m or kg m-2]. - real, optional, intent(in) :: halocline_strat_tol !< A value of the stratification ratio that - !! defines a problematic halocline region [nondim]. - type(interp_CS_type), & - optional, intent(in) :: interp_CS !< Controls for interpolation - - if (.not. associated(CS)) call MOM_error(FATAL, "set_slight_params: CS not associated") - - if (present(max_interface_depths)) then - if (size(max_interface_depths) /= CS%nk+1) & - call MOM_error(FATAL, "set_slight_params: max_interface_depths inconsistent size") - allocate(CS%max_interface_depths(CS%nk+1)) - CS%max_interface_depths(:) = max_interface_depths(:) - endif - - if (present(max_layer_thickness)) then - if (size(max_layer_thickness) /= CS%nk) & - call MOM_error(FATAL, "set_slight_params: max_layer_thickness inconsistent size") - allocate(CS%max_layer_thickness(CS%nk)) - CS%max_layer_thickness(:) = max_layer_thickness(:) - endif - - if (present(min_thickness)) CS%min_thickness = min_thickness - if (present(compressibility_fraction)) CS%compressibility_fraction = compressibility_fraction - - if (present(dz_ml_min)) CS%dz_ml_min = dz_ml_min - if (present(nz_fixed_surface)) CS%nz_fixed_surface = nz_fixed_surface - if (present(Rho_ML_avg_depth)) CS%Rho_ML_avg_depth = Rho_ML_avg_depth - if (present(nlay_ML_offset)) CS%nlay_ML_offset = nlay_ML_offset - if (present(fix_haloclines)) CS%fix_haloclines = fix_haloclines - if (present(halocline_filter_length)) CS%halocline_filter_length = halocline_filter_length - if (present(halocline_strat_tol)) then - if (halocline_strat_tol > 1.0) call MOM_error(FATAL, "set_slight_params: "//& - "HALOCLINE_STRAT_TOL must not exceed 1.0.") - CS%halocline_strat_tol = halocline_strat_tol - endif - - if (present(interp_CS)) CS%interp_CS = interp_CS -end subroutine set_slight_params - -!> Build a SLight coordinate column -subroutine build_slight_column(CS, eqn_of_state, H_to_pres, H_subroundoff, & - nz, depth, h_col, T_col, S_col, p_col, z_col, z_col_new, & - h_neglect, h_neglect_edge) - type(slight_CS), intent(in) :: CS !< Coordinate control structure - type(EOS_type), intent(in) :: eqn_of_state !< Equation of state structure - real, intent(in) :: H_to_pres !< A conversion factor from thicknesses to - !! scaled pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] - real, intent(in) :: H_subroundoff !< GV%H_subroundoff - integer, intent(in) :: nz !< Number of levels - real, intent(in) :: depth !< Depth of ocean bottom (positive [H ~> m or kg m-2]) - real, dimension(nz), intent(in) :: T_col !< T for column [C ~> degC] - real, dimension(nz), intent(in) :: S_col !< S for column [S ~> ppt] - real, dimension(nz), intent(in) :: h_col !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(nz), intent(in) :: p_col !< Layer center pressure [R L2 T-2 ~> Pa] - real, dimension(nz+1), intent(in) :: z_col !< Interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(nz+1), intent(inout) :: z_col_new !< Absolute positions of interfaces [H ~> m or kg m-2] - real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of - !! cell reconstructions [H ~> m or kg m-2]. - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose - !! of edge value calculations [H ~> m or kg m-2]. - ! Local variables - real, dimension(nz) :: rho_col ! Layer densities [R ~> kg m-3] - real, dimension(nz) :: T_f, S_f ! Filtered layer temperature [C ~> degC] and salinity [S ~> ppt] - logical, dimension(nz+1) :: reliable ! If true, this interface is in a reliable position. - real, dimension(nz+1) :: T_int, S_int ! Temperature [C ~> degC] and salinity [S ~> ppt] interpolated to interfaces. - real, dimension(nz+1) :: rho_tmp ! A temporary density [R ~> kg m-3] - real, dimension(nz+1) :: drho_dp ! The partial derivative of density with pressure [T2 L-2 ~> kg m-3 Pa-1] - real, dimension(nz+1) :: p_IS, p_R ! Pressures [R L2 T-2 ~> Pa] - real, dimension(nz+1) :: drhoIS_dT ! The partial derivative of in situ density with temperature - ! in [R C-1 ~> kg m-3 degC-1] - real, dimension(nz+1) :: drhoIS_dS ! The partial derivative of in situ density with salinity - ! in [R S-1 ~> kg m-3 ppt-1] - real, dimension(nz+1) :: drhoR_dT ! The partial derivative of reference density with temperature - ! in [R C-1 ~> kg m-3 degC-1] - real, dimension(nz+1) :: drhoR_dS ! The partial derivative of reference density with salinity - ! in [R S-1 ~> kg m-3 ppt-1] - real, dimension(nz+1) :: strat_rat - real :: H_to_cPa ! A conversion factor from thicknesses to the compressibility fraction times - ! the units of pressure [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1] - real :: drIS, drR ! In situ and reference density differences [R ~> kg m-3] - real :: Fn_now, I_HStol, Fn_zero_val ! Nondimensional variables [nondim] - real :: z_int_unst ! The depth where the stratification allows the interior grid to start [H ~> m or kg m-2] - real :: dz ! A uniform layer thickness in very shallow water [H ~> m or kg m-2]. - real :: dz_ur ! The total thickness of an unstable region [H ~> m or kg m-2]. - real :: wgt, cowgt ! A weight and its complement [nondim]. - real :: rho_ml_av ! The average potential density in a near-surface region [R ~> kg m-3]. - real :: H_ml_av ! A thickness to try to use in taking the near-surface average [H ~> m or kg m-2]. - real :: rho_x_z ! A cumulative integral of a density [R H ~> kg m-2 or kg2 m-5]. - real :: z_wt ! The thickness actually used in taking the near-surface average [H ~> m or kg m-2]. - real :: k_interior ! The (real) value of k where the interior grid starts [nondim]. - real :: k_int2 ! The (real) value of k where the interior grid starts [nondim]. - real :: z_interior ! The depth where the interior grid starts [H ~> m or kg m-2]. - real :: z_ml_fix ! The depth at which the fixed-thickness near-surface layers end [H ~> m or kg m-2]. - real :: dz_dk ! The thickness of layers between the fixed-thickness - ! near-surface layars and the interior [H ~> m or kg m-2]. - real :: Lfilt ! A filtering lengthscale [H ~> m or kg m-2]. - logical :: maximum_depths_set ! If true, the maximum depths of interface have been set. - logical :: maximum_h_set ! If true, the maximum layer thicknesses have been set. - real :: h_tr, b_denom_1, b1, d1 ! Temporary variables used by the tridiagonal solver. - real, dimension(nz) :: c1 ! Temporary variables used by the tridiagonal solver. - integer :: kur1, kur2 ! The indicies at the top and bottom of an unreliable region. - integer :: kur_ss ! The index to start with in the search for the next unstable region. - integer :: k, nkml - - maximum_depths_set = allocated(CS%max_interface_depths) - maximum_h_set = allocated(CS%max_layer_thickness) - - if (z_col(nz+1) - z_col(1) < nz*CS%min_thickness) then - ! This is a nearly massless total depth, so distribute the water evenly. - dz = (z_col(nz+1) - z_col(1)) / real(nz) - do K=2,nz ; z_col_new(K) = z_col(1) + dz*real(K-1) ; enddo - else - call calculate_density(T_col, S_col, p_col, rho_col, eqn_of_state) - - ! Find the locations of the target potential densities, flagging - ! locations in apparently unstable regions as not reliable. - call rho_interfaces_col(rho_col, h_col, z_col, CS%target_density, nz, & - z_col_new, CS, reliable, debug=.true., & - h_neglect=h_neglect, h_neglect_edge=h_neglect_edge) - - ! Ensure that the interfaces are at least CS%min_thickness apart. - if (CS%min_thickness > 0.0) then - ! Move down interfaces below overly thin layers. - do K=2,nz ; if (z_col_new(K) < z_col_new(K-1) + CS%min_thickness) then - z_col_new(K) = z_col_new(K-1) + CS%min_thickness - endif ; enddo - ! Now move up any interfaces that are too close to the bottom. - do K=nz,2,-1 ; if (z_col_new(K) > z_col_new(K+1) - CS%min_thickness) then - z_col_new(K) = z_col_new(K+1) - CS%min_thickness - else - exit ! No more interfaces can be too close to the bottom. - endif ; enddo - endif - - ! Fix up the unreliable regions. - kur_ss = 2 ! reliable(1) and reliable(nz+1) must always be true. - do - ! Search for the uppermost unreliable interface postion. - kur1 = nz+2 - do K=kur_ss,nz ; if (.not.reliable(K)) then - kur1 = K ; exit - endif ; enddo - if (kur1 > nz) exit ! Everything is now reliable. - - kur2 = kur1-1 ! For error checking. - do K=kur1+1,nz+1 ; if (reliable(K)) then - kur2 = K-1 ; kur_ss = K ; exit - endif ; enddo - if (kur2 < kur1) call MOM_error(FATAL, "Bad unreliable range.") - - dz_ur = z_col_new(kur2+1) - z_col_new(kur1-1) - ! drho = CS%target_density(kur2+1) - CS%target_density(kur1-1) - ! Perhaps reset the wgt and cowgt depending on how bad the old interface - ! locations were. - wgt = 1.0 ; cowgt = 0.0 ! = 1.0-wgt - do K=kur1,kur2 - z_col_new(K) = cowgt*z_col_new(K) + & - wgt * (z_col_new(kur1-1) + dz_ur*(K - (kur1-1)) / ((kur2 - kur1) + 2)) - enddo - enddo - - ! Determine which interfaces are in the s-space region and the depth extent - ! of this region. - z_wt = 0.0 ; rho_x_z = 0.0 - H_ml_av = CS%Rho_ml_avg_depth - do k=1,nz - if (z_wt + h_col(k) >= H_ml_av) then - rho_x_z = rho_x_z + rho_col(k) * (H_ml_av - z_wt) - z_wt = H_ml_av - exit - else - rho_x_z = rho_x_z + rho_col(k) * h_col(k) - z_wt = z_wt + h_col(k) - endif - enddo - if (z_wt > 0.0) rho_ml_av = rho_x_z / z_wt - - nkml = CS%nz_fixed_surface - ! Find the interface that matches rho_ml_av. - if (rho_ml_av <= CS%target_density(nkml)) then - k_interior = CS%nlay_ml_offset + real(nkml) - elseif (rho_ml_av > CS%target_density(nz+1)) then - k_interior = real(nz+1) - else ; do K=nkml,nz - if ((rho_ml_av >= CS%target_density(K)) .and. & - (rho_ml_av < CS%target_density(K+1))) then - k_interior = (CS%nlay_ml_offset + K) + & - (rho_ml_av - CS%target_density(K)) / & - (CS%target_density(K+1) - CS%target_density(K)) - exit - endif - enddo ; endif - if (k_interior > real(nz+1)) k_interior = real(nz+1) - - ! Linearly interpolate to find z_interior. This could be made more sophisticated. - K = int(ceiling(k_interior)) - z_interior = (K-k_interior)*z_col_new(K-1) + (1.0+(k_interior-K))*z_col_new(K) - - if (CS%fix_haloclines) then - ! ! Identify regions above the reference pressure where the chosen - ! ! potential density significantly underestimates the actual - ! ! stratification, and use these to find a second estimate of - ! ! z_int_unst and k_interior. - - if (CS%halocline_filter_length > 0.0) then - Lfilt = CS%halocline_filter_length - - ! Filter the temperature and salnity with a fixed lengthscale. - h_tr = h_col(1) + H_subroundoff - b1 = 1.0 / (h_tr + Lfilt) ; d1 = h_tr * b1 - T_f(1) = (b1*h_tr)*T_col(1) ; S_f(1) = (b1*h_tr)*S_col(1) - do k=2,nz - c1(k) = Lfilt * b1 - h_tr = h_col(k) + H_subroundoff ; b_denom_1 = h_tr + d1*Lfilt - b1 = 1.0 / (b_denom_1 + Lfilt) ; d1 = b_denom_1 * b1 - T_f(k) = b1 * (h_tr*T_col(k) + Lfilt*T_f(k-1)) - S_f(k) = b1 * (h_tr*S_col(k) + Lfilt*S_f(k-1)) - enddo - do k=nz-1,1,-1 - T_f(k) = T_f(k) + c1(k+1)*T_f(k+1) ; S_f(k) = S_f(k) + c1(k+1)*S_f(k+1) - enddo - else - do k=1,nz ; T_f(k) = T_col(k) ; S_f(k) = S_col(k) ; enddo - endif - - T_int(1) = T_f(1) ; S_int(1) = S_f(1) - do K=2,nz - T_int(K) = 0.5*(T_f(k-1) + T_f(k)) ; S_int(K) = 0.5*(S_f(k-1) + S_f(k)) - p_IS(K) = z_col(K) * H_to_pres - p_R(K) = CS%ref_pressure + CS%compressibility_fraction * ( p_IS(K) - CS%ref_pressure ) - enddo - T_int(nz+1) = T_f(nz) ; S_int(nz+1) = S_f(nz) - p_IS(nz+1) = z_col(nz+1) * H_to_pres - call calculate_density_derivs(T_int, S_int, p_IS, drhoIS_dT, drhoIS_dS, & - eqn_of_state, (/2,nz/) ) - call calculate_density_derivs(T_int, S_int, p_R, drhoR_dT, drhoR_dS, & - eqn_of_state, (/2,nz/) ) - if (CS%compressibility_fraction > 0.0) then - call calculate_compress(T_int, S_int, p_R(:), rho_tmp, drho_dp, eqn_of_state, (/2,nz/)) - else - do K=2,nz ; drho_dp(K) = 0.0 ; enddo - endif - - H_to_cPa = CS%compressibility_fraction * H_to_pres - strat_rat(1) = 1.0 - do K=2,nz - drIS = drhoIS_dT(K) * (T_f(k) - T_f(k-1)) + & - drhoIS_dS(K) * (S_f(k) - S_f(k-1)) - drR = (drhoR_dT(K) * (T_f(k) - T_f(k-1)) + & - drhoR_dS(K) * (S_f(k) - S_f(k-1))) + & - drho_dp(K) * (H_to_cPa*0.5*(h_col(k) + h_col(k-1))) - - if (drIS <= 0.0) then - strat_rat(K) = 2.0 ! Maybe do this? => ; if (drR < 0.0) strat_rat(K) = -2.0 - else - strat_rat(K) = 2.0*max(drR,0.0) / (drIS + abs(drR)) - endif - enddo - strat_rat(nz+1) = 1.0 - - z_int_unst = 0.0 ; Fn_now = 0.0 - Fn_zero_val = min(2.0*CS%halocline_strat_tol, & - 0.5*(1.0 + CS%halocline_strat_tol)) - if (CS%halocline_strat_tol > 0.0) then - ! Use Adcroft's reciprocal rule. - I_HStol = 0.0 ; if (Fn_zero_val - CS%halocline_strat_tol > 0.0) & - I_HStol = 1.0 / (Fn_zero_val - CS%halocline_strat_tol) - do k=nz,1,-1 ; if (CS%ref_pressure > p_IS(k+1)) then - z_int_unst = z_int_unst + Fn_now * h_col(k) - if (strat_rat(K) <= Fn_zero_val) then - if (strat_rat(K) <= CS%halocline_strat_tol) then ; Fn_now = 1.0 - else - Fn_now = max(Fn_now, (Fn_zero_val - strat_rat(K)) * I_HStol) - endif - endif - endif ; enddo - else - do k=nz,1,-1 ; if (CS%ref_pressure > p_IS(k+1)) then - z_int_unst = z_int_unst + Fn_now * h_col(k) - if (strat_rat(K) <= CS%halocline_strat_tol) Fn_now = 1.0 - endif ; enddo - endif - - if (z_interior < z_int_unst) then - ! Find a second estimate of the extent of the s-coordinate region. - kur1 = max(int(ceiling(k_interior)),2) - if (z_col_new(kur1-1) < z_interior) then - k_int2 = kur1 - do K = kur1,nz+1 ; if (z_col_new(K) >= z_int_unst) then - ! This is linear interpolation again. - if (z_col_new(K-1) >= z_int_unst) & - call MOM_error(FATAL,"build_grid_SLight, bad halocline structure.") - k_int2 = real(K-1) + (z_int_unst - z_col_new(K-1)) / & - (z_col_new(K) - z_col_new(K-1)) - exit - endif ; enddo - if (z_col_new(nz+1) < z_int_unst) then - ! This should be unnecessary. - z_int_unst = z_col_new(nz+1) ; k_int2 = real(nz+1) - endif - - ! Now take the larger values. - if (k_int2 > k_interior) then - k_interior = k_int2 ; z_interior = z_int_unst - endif - endif - endif - endif ! fix_haloclines - - z_col_new(1) = 0.0 - do K=2,nkml+1 - z_col_new(K) = min((K-1)*CS%dz_ml_min, & - z_col_new(nz+1) - CS%min_thickness*(nz+1-K)) - enddo - z_ml_fix = z_col_new(nkml+1) - if (z_interior > z_ml_fix) then - dz_dk = (z_interior - z_ml_fix) / (k_interior - (nkml+1)) - do K=nkml+2,int(floor(k_interior)) - z_col_new(K) = z_ml_fix + dz_dk * (K - (nkml+1)) - enddo - else ! The fixed-thickness z-region penetrates into the interior. - do K=nkml+2,nz - if (z_col_new(K) <= z_col_new(CS%nz_fixed_surface+1)) then - z_col_new(K) = z_col_new(CS%nz_fixed_surface+1) - else ; exit ; endif - enddo - endif - - if (maximum_depths_set .and. maximum_h_set) then ; do k=2,nz - ! The loop bounds are 2 & nz so the top and bottom interfaces do not move. - ! Recall that z_col_new is positive downward. - z_col_new(K) = min(z_col_new(K), CS%max_interface_depths(K), & - z_col_new(K-1) + CS%max_layer_thickness(k-1)) - enddo ; elseif (maximum_depths_set) then ; do K=2,nz - z_col_new(K) = min(z_col_new(K), CS%max_interface_depths(K)) - enddo ; elseif (maximum_h_set) then ; do k=2,nz - z_col_new(K) = min(z_col_new(K), z_col_new(K-1) + CS%max_layer_thickness(k-1)) - enddo ; endif - - endif ! Total thickness exceeds nz*CS%min_thickness. - -end subroutine build_slight_column - -!> Finds the new interface locations in a column of water that match the -!! prescribed target densities. -subroutine rho_interfaces_col(rho_col, h_col, z_col, rho_tgt, nz, z_col_new, & - CS, reliable, debug, h_neglect, h_neglect_edge) - integer, intent(in) :: nz !< Number of layers - real, dimension(nz), intent(in) :: rho_col !< Initial layer reference densities [R ~> kg m-3]. - real, dimension(nz), intent(in) :: h_col !< Initial layer thicknesses [H ~> m or kg m-2]. - real, dimension(nz+1), intent(in) :: z_col !< Initial interface heights [H ~> m or kg m-2]. - real, dimension(nz+1), intent(in) :: rho_tgt !< Interface target densities. - real, dimension(nz+1), intent(inout) :: z_col_new !< New interface heights [H ~> m or kg m-2]. - type(slight_CS), intent(in) :: CS !< Coordinate control structure - logical, dimension(nz+1), intent(inout) :: reliable !< If true, the interface positions - !! are well defined from a stable region. - logical, optional, intent(in) :: debug !< If present and true, do debugging checks. - real, optional, intent(in) :: h_neglect !< A negligibly small width for the purpose of - !! cell reconstructions [H ~> m or kg m-2] - real, optional, intent(in) :: h_neglect_edge !< A negligibly small width for the purpose - !! of edge value calculations [H ~> m or kg m-2] - - real, dimension(nz+1) :: ru_max_int ! The maximum and minimum densities in - real, dimension(nz+1) :: ru_min_int ! an unstable region around an interface [R ~> kg m-3]. - real, dimension(nz) :: ru_max_lay ! The maximum and minimum densities in - real, dimension(nz) :: ru_min_lay ! an unstable region containing a layer [R ~> kg m-3]. - real, dimension(nz,2) :: ppoly_i_E ! Edge value of polynomial [R ~> kg m-3] - real, dimension(nz,2) :: ppoly_i_S ! Edge slope of polynomial [R H-1 ~> kg m-4 or m-1] - real, dimension(nz,DEGREE_MAX+1) :: ppoly_i_coefficients ! Coefficients of polynomial [R ~> kg m-3] - logical, dimension(nz) :: unstable_lay ! If true, this layer is in an unstable region. - logical, dimension(nz+1) :: unstable_int ! If true, this interface is in an unstable region. - real :: rt ! The current target density [R ~> kg m-3]. - real :: zf ! The fractional z-position within a layer of the target density [nondim]. - real :: rfn ! The target density relative to the interpolated density [R ~> kg m-3] - real :: a(5) ! Coefficients of a local polynomial minus the target density [R ~> kg m-3]. - real :: zf1, zf2 ! Two previous estimates of zf [nondim] - real :: rfn1, rfn2 ! Values of rfn at zf1 and zf2 [R ~> kg m-3] - real :: drfn_dzf ! The partial derivative of rfn with zf [R ~> kg m-3] - real :: sgn, delta_zf, zf_prev ! [nondim] - real :: tol ! The tolerance for convergence of zf [nondim] - logical :: k_found ! If true, the position has been found. - integer :: k_layer ! The index of the stable layer containing an interface. - integer :: ppoly_degree - integer :: k, k1, k1_min, itt, max_itt, m - - real :: z_sgn ! 1 or -1, depending on whether z increases with increasing K. - logical :: debugging - - debugging = .false. ; if (present(debug)) debugging = debug - max_itt = NR_ITERATIONS - tol = NR_TOLERANCE - - z_sgn = 1.0 ; if ( z_col(1) > z_col(nz+1) ) z_sgn = -1.0 - if (debugging) then - do K=1,nz - if (abs((z_col(K+1) - z_col(K)) - z_sgn*h_col(k)) > & - 1.0e-14*(abs(z_col(K+1)) + abs(z_col(K)) + abs(h_col(k))) ) & - call MOM_error(FATAL, "rho_interfaces_col: Inconsistent z_col and h_col") - enddo - endif - - if ( z_col(1) == z_col(nz+1) ) then - ! This is a massless column! - do K=1,nz+1 ; z_col_new(K) = z_col(1) ; reliable(K) = .true. ; enddo - return - endif - - ! This sets up the piecewise polynomials based on the rho_col profile. - call regridding_set_ppolys(CS%interp_CS, rho_col, nz, h_col, ppoly_i_E, ppoly_i_S, & - ppoly_i_coefficients, ppoly_degree, h_neglect, h_neglect_edge) - - ! Determine the density ranges of unstably stratified segments. - ! Interfaces that start out in an unstably stratified segment can - ! only escape if they are outside of the bounds of that segment, and no - ! interfaces are ever mapped into an unstable segment. - unstable_int(1) = .false. - ru_max_int(1) = ppoly_i_E(1,1) - - unstable_lay(1) = (ppoly_i_E(1,1) > ppoly_i_E(1,2)) - ru_max_lay(1) = max(ppoly_i_E(1,1), ppoly_i_E(1,2)) - - do K=2,nz - unstable_int(K) = (ppoly_i_E(k-1,2) > ppoly_i_E(k,1)) - ru_max_int(K) = max(ppoly_i_E(k-1,2), ppoly_i_E(k,1)) - ru_min_int(K) = min(ppoly_i_E(k-1,2), ppoly_i_E(k,1)) - if (unstable_int(K) .and. unstable_lay(k-1)) & - ru_max_int(K) = max(ru_max_lay(k-1), ru_max_int(K)) - - unstable_lay(k) = (ppoly_i_E(k,1) > ppoly_i_E(k,2)) - ru_max_lay(k) = max(ppoly_i_E(k,1), ppoly_i_E(k,2)) - ru_min_lay(k) = min(ppoly_i_E(k,1), ppoly_i_E(k,2)) - if (unstable_lay(k) .and. unstable_int(K)) & - ru_max_lay(k) = max(ru_max_int(K), ru_max_lay(k)) - enddo - unstable_int(nz+1) = .false. - ru_min_int(nz+1) = ppoly_i_E(nz,2) - - do K=nz,1,-1 - if (unstable_lay(k) .and. unstable_int(K+1)) & - ru_min_lay(k) = min(ru_min_int(K+1), ru_min_lay(k)) - - if (unstable_int(K) .and. unstable_lay(k)) & - ru_min_int(K) = min(ru_min_lay(k), ru_min_int(K)) - enddo - - z_col_new(1) = z_col(1) ; reliable(1) = .true. - k1_min = 1 - do K=2,nz ! Find the locations of the various target densities for the interfaces. - rt = rho_tgt(K) - k_layer = -1 - k_found = .false. - - ! Many light layers are found at the top, so start there. - if (rt <= ppoly_i_E(k1_min,1)) then - z_col_new(K) = z_col(k1_min) - k_found = .true. - ! Do not change k1_min for the next layer. - elseif (k1_min == nz+1) then - z_col_new(K) = z_col(nz+1) - else - ! Start with the previous location and search outward. - if (unstable_int(K) .and. (rt >= ru_min_int(K)) .and. (rt <= ru_max_int(K))) then - ! This interface started in an unstable region and should not move due to remapping. - z_col_new(K) = z_col(K) ; reliable(K) = .false. - k1_min = K ; k_found = .true. - elseif ((rt >= ppoly_i_E(k-1,2)) .and. (rt <= ppoly_i_E(k,1))) then - ! This interface is already in the right place and does not move. - z_col_new(K) = z_col(K) ; reliable(K) = .true. - k1_min = K ; k_found = .true. - elseif (rt < ppoly_i_E(k-1,2)) then ! Search upward - do k1=K-1,k1_min,-1 - ! Check whether rt is in layer k. - if ((rt < ppoly_i_E(k1,2)) .and. (rt > ppoly_i_E(k1,1))) then - ! rt is in layer k. - k_layer = k1 - k1_min = k1 ; k_found = .true. ; exit - elseif (unstable_lay(k1) .and. (rt >= ru_min_lay(k1)) .and. (rt <= ru_max_lay(K1))) then - ! rt would be found at unstable layer that it can not penetrate. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1+1) ; reliable(K) = .false. - k1_min = k1 ; k_found = .true. ; exit - endif - ! Check whether rt is at interface K. - if (k1 > 1) then ; if ((rt <= ppoly_i_E(k1,1)) .and. (rt >= ppoly_i_E(k1-1,2))) then - ! rt is at interface K1 - z_col_new(K) = z_col(K1) ; reliable(K) = .true. - k1_min = k1 ; k_found = .true. ; exit - elseif (unstable_int(K1) .and. (rt >= ru_min_int(k1)) .and. (rt <= ru_max_int(K1))) then - ! rt would be found at an unstable interface that it can not pass. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1) ; reliable(K) = .false. - k1_min = k1 ; k_found = .true. ; exit - endif ; endif - enddo - - if (.not.k_found) then - ! This should not happen unless k1_min = 1. - if (k1_min < 2) then - z_col_new(K) = z_col(k1_min) - else - z_col_new(K) = z_col(k1_min) - endif - endif - - else ! Search downward - do k1=K,nz - if ((rt < ppoly_i_E(k1,2)) .and. (rt > ppoly_i_E(k1,1))) then - ! rt is in layer k. - k_layer = k1 - k1_min = k1 ; k_found = .true. ; exit - elseif (unstable_lay(k1) .and. (rt >= ru_min_lay(k1)) .and. (rt <= ru_max_lay(K1))) then - ! rt would be found at unstable layer that it can not penetrate. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1) - reliable(K) = .false. - k1_min = k1 ; k_found = .true. ; exit - endif - if (k1 < nz) then ; if ((rt <= ppoly_i_E(k1+1,1)) .and. (rt >= ppoly_i_E(k1,2))) then - ! rt is at interface K1+1 - - z_col_new(K) = z_col(K1+1) ; reliable(K) = .true. - k1_min = k1+1 ; k_found = .true. ; exit - elseif (unstable_int(K1+1) .and. (rt >= ru_min_int(k1+1)) .and. (rt <= ru_max_int(K1+1))) then - ! rt would be found at an unstable interface that it can not pass. - ! It is possible that this can never happen? - z_col_new(K) = z_col(K1+1) - reliable(K) = .false. - k1_min = k1+1 ; k_found = .true. ; exit - endif ; endif - enddo - if (.not.k_found) then - z_col_new(K) = z_col(nz+1) - if (rt >= ppoly_i_E(nz,2)) then - reliable(K) = .true. - else - reliable(K) = .false. - endif - endif - endif - - if (k_layer > 0) then ! The new location is inside of layer k_layer. - ! Note that this is coded assuming that this layer is stably stratified. - if (.not.(ppoly_i_E(k1,2) > ppoly_i_E(k1,1))) call MOM_error(FATAL, & - "build_grid_SLight: Erroneously searching for an interface in an unstratified layer.") - - ! Use the false position method to find the location (degree <= 1) or the first guess. - zf = (rt - ppoly_i_E(k1,1)) / (ppoly_i_E(k1,2) - ppoly_i_E(k1,1)) - - if (ppoly_degree > 1) then ! Iterate to find the solution. - a(:) = 0.0 ; a(1) = ppoly_i_coefficients(k_layer,1) - rt - do m=2,ppoly_degree+1 ; a(m) = ppoly_i_coefficients(k_layer,m) ; enddo - ! Bracket the root. - zf1 = 0.0 ; rfn1 = a(1) - zf2 = 1.0 ; rfn2 = a(1) + (a(2) + (a(3) + (a(4) + a(5)))) - if (rfn1 * rfn2 > 0.0) call MOM_error(FATAL, "build_grid_SLight: Bad bracketing.") - - do itt=1,max_itt - rfn = a(1) + zf*(a(2) + zf*(a(3) + zf*(a(4) + zf*a(5)))) - ! Reset one of the ends of the bracket. - if (rfn * rfn1 > 0.0) then - zf1 = zf ; rfn1 = rfn - else - zf2 = zf ; rfn2 = rfn - endif - if (rfn1 == rfn2) exit - - drfn_dzf = (a(2) + zf*(2.0*a(3) + zf*(3.0*a(4) + zf*4.0*a(5)))) - sgn = 1.0 ; if (drfn_dzf < 0.0) sgn = -1.0 - - if ((sgn*(zf - rfn) >= zf1 * abs(drfn_dzf)) .and. & - (sgn*(zf - rfn) <= zf2 * abs(drfn_dzf))) then - delta_zf = -rfn / drfn_dzf - zf = zf + delta_zf - else ! Newton's method goes out of bounds, so use a false position method estimate - zf_prev = zf - zf = ( rfn2 * zf1 - rfn1 * zf2 ) / (rfn2 - rfn1) - delta_zf = zf - zf_prev - endif - - if (abs(delta_zf) < tol) exit - enddo - endif - z_col_new(K) = z_col(k_layer) + zf * z_sgn * h_col(k_layer) - reliable(K) = .true. - endif - - endif - - enddo - z_col_new(nz+1) = z_col(nz+1) ; reliable(nz+1) = .true. - -end subroutine rho_interfaces_col - -end module coord_slight diff --git a/src/ALE/regrid_consts.F90 b/src/ALE/regrid_consts.F90 index 9fe638dd5b..0c5ccf268f 100644 --- a/src/ALE/regrid_consts.F90 +++ b/src/ALE/regrid_consts.F90 @@ -16,8 +16,6 @@ module regrid_consts integer, parameter :: REGRIDDING_SIGMA = 4 !< Sigma coordinates identifier integer, parameter :: REGRIDDING_ARBITRARY = 5 !< Arbitrary coordinates identifier integer, parameter :: REGRIDDING_HYCOM1 = 6 !< Simple HyCOM coordinates without BBL -integer, parameter :: REGRIDDING_SLIGHT = 7 !< Identifier for stretched coordinates in the - !! lightest water, isopycnal below integer, parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR = 8 !< Identifiered for z* coordinates at the bottom, !! sigma-near the top integer, parameter :: REGRIDDING_ADAPTIVE = 9 !< Adaptive coordinate mode identifier @@ -31,7 +29,6 @@ module regrid_consts character(len=*), parameter :: REGRIDDING_ARBITRARY_STRING = "ARB" !< Arbitrary coordinates character(len=*), parameter :: REGRIDDING_HYCOM1_STRING = "HYCOM1" !< Hycom string character(len=*), parameter :: REGRIDDING_HYBGEN_STRING = "HYBGEN" !< Hybgen string -character(len=*), parameter :: REGRIDDING_SLIGHT_STRING = "SLIGHT" !< Hybrid S-rho string character(len=*), parameter :: REGRIDDING_SIGMA_SHELF_ZSTAR_STRING = "SIGMA_SHELF_ZSTAR" !< Hybrid z*/sigma character(len=*), parameter :: REGRIDDING_ADAPTIVE_STRING = "ADAPTIVE" !< Adaptive coordinate string character(len=*), parameter :: DEFAULT_COORDINATE_MODE = REGRIDDING_LAYER_STRING !< Default coordinate mode @@ -63,7 +60,6 @@ function coordinateMode(string) case (trim(REGRIDDING_SIGMA_STRING)); coordinateMode = REGRIDDING_SIGMA case (trim(REGRIDDING_HYCOM1_STRING)); coordinateMode = REGRIDDING_HYCOM1 case (trim(REGRIDDING_HYBGEN_STRING)); coordinateMode = REGRIDDING_HYBGEN - case (trim(REGRIDDING_SLIGHT_STRING)); coordinateMode = REGRIDDING_SLIGHT case (trim(REGRIDDING_ARBITRARY_STRING)); coordinateMode = REGRIDDING_ARBITRARY case (trim(REGRIDDING_SIGMA_SHELF_ZSTAR_STRING)); coordinateMode = REGRIDDING_SIGMA_SHELF_ZSTAR case (trim(REGRIDDING_ADAPTIVE_STRING)); coordinateMode = REGRIDDING_ADAPTIVE @@ -85,7 +81,6 @@ function coordinateUnitsI(coordMode) case (REGRIDDING_SIGMA); coordinateUnitsI = "Non-dimensional" case (REGRIDDING_HYCOM1); coordinateUnitsI = "m" case (REGRIDDING_HYBGEN); coordinateUnitsI = "m" - case (REGRIDDING_SLIGHT); coordinateUnitsI = "m" case (REGRIDDING_ADAPTIVE); coordinateUnitsI = "m" case default ; call MOM_error(FATAL, "coordinateUnts: "//& "Unrecognized coordinate mode.") @@ -121,7 +116,6 @@ logical function state_dependent_int(mode) case (REGRIDDING_SIGMA); state_dependent_int = .false. case (REGRIDDING_HYCOM1); state_dependent_int = .true. case (REGRIDDING_HYBGEN); state_dependent_int = .true. - case (REGRIDDING_SLIGHT); state_dependent_int = .true. case (REGRIDDING_ADAPTIVE); state_dependent_int = .true. case default ; call MOM_error(FATAL, "state_dependent: "//& "Unrecognized choice of coordinate.") diff --git a/src/ALE/regrid_edge_values.F90 b/src/ALE/regrid_edge_values.F90 index 3f59fac60f..9b574348af 100644 --- a/src/ALE/regrid_edge_values.F90 +++ b/src/ALE/regrid_edge_values.F90 @@ -14,7 +14,7 @@ module regrid_edge_values ! The following routines are visible to the outside world ! ----------------------------------------------------------------------------- public bound_edge_values, average_discontinuous_edge_values, check_discontinuous_edge_values -public edge_values_explicit_h2, edge_values_explicit_h4 +public edge_values_explicit_h2, edge_values_explicit_h4, edge_values_explicit_h4cw public edge_values_implicit_h4, edge_values_implicit_h6 public edge_slopes_implicit_h3, edge_slopes_implicit_h5 @@ -357,6 +357,106 @@ subroutine edge_values_explicit_h4( N, h, u, edge_val, h_neglect, answer_date ) end subroutine edge_values_explicit_h4 +!> Compute h4 edge values (explicit fourth order accurate) +!! in the same units as u. +!! +!! From (Colella & Woodward, JCP, 1984) and based on hybgen_ppm_coefs. +!! +!! Compute edge values based on fourth-order explicit estimates. +!! These estimates are based on a cubic interpolant spanning four cells +!! and evaluated at the location of the middle edge. An interpolant spanning +!! cells i-2, i-1, i and i+1 is evaluated at edge i-1/2. The estimate for +!! each edge is unique. +!! +!! i-2 i-1 i i+1 +!! ..--o------o------o------o------o--.. +!! i-1/2 +!! +!! For this fourth-order scheme, at least four cells must exist. +subroutine edge_values_explicit_h4cw( N, h, u, edge_val, h_neglect ) + integer, intent(in) :: N !< Number of cells + real, dimension(N), intent(in) :: h !< cell widths [H] + real, dimension(N), intent(in) :: u !< cell average properties in arbitrary units [A] + real, dimension(N,2), intent(inout) :: edge_val !< Returned edge values [A]; the second index + !! is for the two edges of each cell. + real, optional, intent(in) :: h_neglect !< A negligibly small width [H] + + ! Local variables + real :: dp(N) ! Input grid layer thicknesses, but with a minimum thickness [H ~> m or kg m-2] + real :: hNeglect ! A negligible thickness in the same units as h + real :: da ! Difference between the unlimited scalar edge value estimates [A] + real :: a6 ! Scalar field differences that are proportional to the curvature [A] + real :: slk, srk ! Differences between adjacent cell averages of scalars [A] + real :: sck ! Scalar differences across a cell. + real :: au(N) ! Scalar field difference across each cell [A] + real :: al(N), ar(N) ! Scalar field at the left and right edges of a cell [A] + real :: h112(N+1), h122(N+1) ! Combinations of thicknesses [H ~> m or kg m-2] + real :: I_h12(N+1) ! Inverses of combinations of thickesses [H-1 ~> m-1 or m2 kg-1] + real :: h2_h123(N) ! A ratio of a layer thickness of the sum of 3 adjacent thicknesses [nondim] + real :: I_h0123(N) ! Inverse of the sum of 4 adjacent thicknesses [H-1 ~> m-1 or m2 kg-1] + real :: h01_h112(N+1) ! A ratio of sums of adjacent thicknesses [nondim], 2/3 in the limit of uniform thicknesses. + real :: h23_h122(N+1) ! A ratio of sums of adjacent thicknesses [nondim], 2/3 in the limit of uniform thicknesses. + integer :: k + + hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect + + ! Set the thicknesses for very thin layers to some minimum value. + do k=1,N ; dp(k) = max(h(k), hNeglect) ; enddo + + !compute grid metrics + do k=2,N + h112(K) = 2.*dp(k-1) + dp(k) + h122(K) = dp(k-1) + 2.*dp(k) + I_h12(K) = 1.0 / (dp(k-1) + dp(k)) + enddo !k + do k=2,N-1 + h2_h123(k) = dp(k) / (dp(k) + (dp(k-1)+dp(k+1))) + enddo + do K=3,N-1 + I_h0123(K) = 1.0 / ((dp(k-2) + dp(k-1)) + (dp(k) + dp(k+1))) + + h01_h112(K) = (dp(k-2) + dp(k-1)) / (2.0*dp(k-1) + dp(k)) + h23_h122(K) = (dp(k) + dp(k+1)) / (dp(k-1) + 2.0*dp(k)) + enddo + + !Compute average slopes: Colella, Eq. (1.8) + au(1) = 0. + do k=2,N-1 + slk = u(k )-u(k-1) + srk = u(k+1)-u(k) + if (slk*srk > 0.) then + sck = h2_h123(k)*( h112(K)*srk*I_h12(K+1) + h122(K+1)*slk*I_h12(K) ) + au(k) = sign(min(abs(2.0*slk), abs(sck), abs(2.0*srk)), sck) + else + au(k) = 0. + endif + enddo !k + au(N) = 0. + + !Compute "first guess" edge values: Colella, Eq. (1.6) + al(1) = u(1) ! 1st layer PCM + ar(1) = u(1) ! 1st layer PCM + al(2) = u(1) ! 1st layer PCM + do K=3,N-1 + ! This is a 4th order explicit edge value estimate. + al(k) = (dp(k)*u(k-1) + dp(k-1)*u(k)) * I_h12(K) & + + I_h0123(K)*( 2.*dp(k)*dp(k-1)*I_h12(K)*(u(k)-u(k-1)) * & + ( h01_h112(K) - h23_h122(K) ) & + + (dp(k)*au(k-1)*h23_h122(K) - dp(k-1)*au(k)*h01_h112(K)) ) + ar(k-1) = al(k) + enddo !k + ar(N-1) = u(N) ! last layer PCM + al(N) = u(N) ! last layer PCM + ar(N) = u(N) ! last layer PCM + + !Set coefficients + do k=1,N + edge_val(k,1) = al(k) + edge_val(k,2) = ar(k) + enddo !k + +end subroutine edge_values_explicit_h4cw + !> Compute ih4 edge values (implicit fourth order accurate) !! in the same units as u. !! diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index dbe364c969..e119ce9d53 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -7,11 +7,13 @@ module regrid_interp use MOM_string_functions, only : uppercase use regrid_edge_values, only : edge_values_explicit_h2, edge_values_explicit_h4 +use regrid_edge_values, only : edge_values_explicit_h4cw use regrid_edge_values, only : edge_values_implicit_h4, edge_values_implicit_h6 use regrid_edge_values, only : edge_slopes_implicit_h3, edge_slopes_implicit_h5 use PLM_functions, only : PLM_reconstruction, PLM_boundary_extrapolation use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use PPM_functions, only : PPM_monotonicity use PQM_functions, only : PQM_reconstruction, PQM_boundary_extrapolation_v1 use P1M_functions, only : P1M_interpolation, P1M_boundary_extrapolation @@ -32,7 +34,8 @@ module regrid_interp logical :: boundary_extrapolation !> The vintage of the expressions to use for remapping - integer :: answer_date = 20181231 !### Change to 99991231? + integer :: answer_date = 20181231 + !### Changing this to 99991231 changes answers in rho and Hycom1 configurations. !### There is no point where the value of answer_date is reset. end type interp_CS_type @@ -44,6 +47,7 @@ module regrid_interp integer, parameter :: INTERPOLATION_P1M_H4 = 1 !< O(h^2) integer, parameter :: INTERPOLATION_P1M_IH4 = 2 !< O(h^2) integer, parameter :: INTERPOLATION_PLM = 3 !< O(h^2) +integer, parameter :: INTERPOLATION_PPM_CW =10 !< O(h^3) integer, parameter :: INTERPOLATION_PPM_H4 = 4 !< O(h^3) integer, parameter :: INTERPOLATION_PPM_IH4 = 5 !< O(h^3) integer, parameter :: INTERPOLATION_P3M_IH4IH3 = 6 !< O(h^4) @@ -143,6 +147,25 @@ subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & call PLM_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect ) endif + case ( INTERPOLATION_PPM_CW ) + if ( n0 >= 4 ) then + degree = DEGREE_2 + call edge_values_explicit_h4cw( n0, h0, densities, ppoly0_E, h_neglect_edge ) + call PPM_monotonicity( n0, densities, ppoly0_E ) + call PPM_reconstruction( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) + if (extrapolate) then + call PPM_boundary_extrapolation( n0, h0, densities, ppoly0_E, & + ppoly0_coefs, h_neglect ) + endif + else + degree = DEGREE_1 + call edge_values_explicit_h2( n0, h0, densities, ppoly0_E ) + call P1M_interpolation( n0, h0, densities, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=CS%answer_date ) + if (extrapolate) then + call P1M_boundary_extrapolation( n0, h0, densities, ppoly0_E, ppoly0_coefs ) + endif + endif + case ( INTERPOLATION_PPM_H4 ) if ( n0 >= 4 ) then degree = DEGREE_2 @@ -485,7 +508,7 @@ end function get_polynomial_coordinate !> Numeric value of interpolation_scheme corresponding to scheme name integer function interpolation_scheme(interp_scheme) character(len=*), intent(in) :: interp_scheme !< Name of the interpolation scheme - !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_H4", + !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_CW", "PPM_H4", !! "PPM_IH4", "P3M_IH4IH3", "P3M_IH6IH5", "PQM_IH4IH3", and "PQM_IH6IH5" select case ( uppercase(trim(interp_scheme)) ) @@ -493,6 +516,7 @@ integer function interpolation_scheme(interp_scheme) case ("P1M_H4"); interpolation_scheme = INTERPOLATION_P1M_H4 case ("P1M_IH2"); interpolation_scheme = INTERPOLATION_P1M_IH4 case ("PLM"); interpolation_scheme = INTERPOLATION_PLM + case ("PPM_CW"); interpolation_scheme = INTERPOLATION_PPM_CW case ("PPM_H4"); interpolation_scheme = INTERPOLATION_PPM_H4 case ("PPM_IH4"); interpolation_scheme = INTERPOLATION_PPM_IH4 case ("P3M_IH4IH3"); interpolation_scheme = INTERPOLATION_P3M_IH4IH3 @@ -508,7 +532,7 @@ end function interpolation_scheme subroutine set_interp_scheme(CS, interp_scheme) type(interp_CS_type), intent(inout) :: CS !< A control structure for regrid_interp character(len=*), intent(in) :: interp_scheme !< Name of the interpolation scheme - !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_H4", + !! Valid values include "P1M_H2", "P1M_H4", "P1M_IH2", "PLM", "PPM_CW", "PPM_H4", !! "PPM_IH4", "P3M_IH4IH3", "P3M_IH6IH5", "PQM_IH4IH3", and "PQM_IH6IH5" CS%interpolation_scheme = interpolation_scheme(interp_scheme) diff --git a/src/ALE/remapping_attic.F90 b/src/ALE/remapping_attic.F90 new file mode 100644 index 0000000000..534428aaed --- /dev/null +++ b/src/ALE/remapping_attic.F90 @@ -0,0 +1,648 @@ +!> Retains older versions of column-wise vertical remapping functions that are +!! no longer used in MOM6, but may be useful later for documenting the development +!! of the schemes that are used in MOM6. +module remapping_attic + +! This file is part of MOM6. See LICENSE.md for the license. +! Original module written by Laurent White, 2008.06.09 + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_io, only : stdout +use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation +use regrid_edge_values, only : edge_values_explicit_h4 + +implicit none ; private + +! The following routines are visible to the outside world +public remapping_attic_unit_tests, remapByProjection, remapByDeltaZ +public isPosSumErrSignificant + +! The following are private parameter constants +integer, parameter :: INTEGRATION_PCM = 0 !< Piecewise Constant Method +integer, parameter :: INTEGRATION_PLM = 1 !< Piecewise Linear Method +integer, parameter :: INTEGRATION_PPM = 3 !< Piecewise Parabolic Method +integer, parameter :: INTEGRATION_PQM = 5 !< Piecewise Quartic Method + +! This CPP macro turns on/off bounding of integrations limits so that they are +! always within the cell. Roundoff can lead to the non-dimensional bounds being +! outside of the range 0 to 1. +#define __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + +real, parameter :: hNeglect_dflt = 1.E-30 !< A thickness [H ~> m or kg m-2] that can be + !! added to thicknesses in a denominator without + !! changing the numerical result, except where + !! a division by zero would otherwise occur. + +contains + +!> Compare two summation estimates of positive data and judge if due to more +!! than round-off. +!! When two sums are calculated from different vectors that should add up to +!! the same value, the results can differ by round off. The round off error +!! can be bounded to be proportional to the number of operations. +!! This function returns true if the difference between sum1 and sum2 is +!! larger than than the estimated round off bound. +!! \note This estimate/function is only valid for summation of positive data. +function isPosSumErrSignificant(n1, sum1, n2, sum2) + integer, intent(in) :: n1 !< Number of values in sum1 + integer, intent(in) :: n2 !< Number of values in sum2 + real, intent(in) :: sum1 !< Sum of n1 values [A] + real, intent(in) :: sum2 !< Sum of n2 values [A] + logical :: isPosSumErrSignificant !< True if difference in sums is large + ! Local variables + real :: sumErr, allowedErr, eps + + if (sum1<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum1<0 is not allowed!') + if (sum2<0.) call MOM_error(FATAL,'isPosSumErrSignificant: sum2<0 is not allowed!') + sumErr = abs(sum1-sum2) + eps = epsilon(sum1) + allowedErr = eps*0.5*(real(n1-1)*sum1+real(n2-1)*sum2) + if (sumErr>allowedErr) then + write(0,*) 'isPosSumErrSignificant: sum1,sum2=',sum1,sum2 + write(0,*) 'isPosSumErrSignificant: eps=',eps + write(0,*) 'isPosSumErrSignificant: err,n*eps=',sumErr,allowedErr + write(0,*) 'isPosSumErrSignificant: err/eps,n1,n2,n1+n2=',sumErr/eps,n1,n2,n1+n2 + isPosSumErrSignificant = .true. + else + isPosSumErrSignificant = .false. + endif +end function isPosSumErrSignificant + +!> Remaps column of values u0 on grid h0 to grid h1 by integrating +!! over the projection of each h1 cell onto the h0 grid. +subroutine remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n1, h1, method, u1, h_neglect ) + integer, intent(in) :: n0 !< Number of cells in source grid + real, intent(in) :: h0(:) !< Source grid widths (size n0) + real, intent(in) :: u0(:) !< Source cell averages (size n0) + real, intent(in) :: ppoly0_E(:,:) !< Edge value of polynomial + real, intent(in) :: ppoly0_coefs(:,:) !< Coefficients of polynomial + integer, intent(in) :: n1 !< Number of cells in target grid + real, intent(in) :: h1(:) !< Target grid widths (size n1) + integer, intent(in) :: method !< Remapping scheme to use + real, intent(out) :: u1(:) !< Target cell averages (size n1) + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h. + ! Local variables + integer :: iTarget + real :: xL, xR ! coordinates of target cell edges + integer :: jStart ! Used by integrateReconOnInterval() + real :: xStart ! Used by integrateReconOnInterval() + + ! Loop on cells in target grid (grid1). For each target cell, we need to find + ! in which source cells the target cell edges lie. The associated indexes are + ! noted j0 and j1. + xR = 0. ! Left boundary is at x=0 + jStart = 1 + xStart = 0. + do iTarget = 1,n1 + ! Determine the coordinates of the target cell edges + xL = xR + xR = xL + h1(iTarget) + + call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & + xL, xR, h1(iTarget), u1(iTarget), jStart, xStart, h_neglect ) + + enddo ! end iTarget loop on target grid cells + +end subroutine remapByProjection + +!> Remaps column of values u0 on grid h0 to implied grid h1 +!! where the interfaces of h1 differ from those of h0 by dx. +!! The new grid is defined relative to the original grid by change +!! dx1(:) = xNew(:) - xOld(:) +!! and the remapping calculated so that +!! hNew(k) qNew(k) = hOld(k) qOld(k) + F(k+1) - F(k) +!! where +!! F(k) = dx1(k) qAverage +!! and where qAverage is the average qOld in the region zOld(k) to zNew(k). +subroutine remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, n1, dx1, & + method, u1, h1, h_neglect ) + integer, intent(in) :: n0 !< Number of cells in source grid + real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) + real, dimension(:), intent(in) :: u0 !< Source cell averages (size n0) + real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial + real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial + integer, intent(in) :: n1 !< Number of cells in target grid + real, dimension(:), intent(in) :: dx1 !< Target grid edge positions (size n1+1) + integer, intent(in) :: method !< Remapping scheme to use + real, dimension(:), intent(out) :: u1 !< Target cell averages (size n1) + real, dimension(:), & + optional, intent(out) :: h1 !< Target grid widths (size n1) + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h. + ! Local variables + integer :: iTarget + real :: xL, xR ! coordinates of target cell edges + real :: xOld, hOld, uOld + real :: xNew, hNew, h_err + real :: uhNew, hFlux, uAve, fluxL, fluxR + integer :: jStart ! Used by integrateReconOnInterval() + real :: xStart ! Used by integrateReconOnInterval() + + ! Loop on cells in target grid. For each cell, iTarget, the left flux is + ! the right flux of the cell to the left, iTarget-1. + ! The left flux is initialized by started at iTarget=0 to calculate the + ! right flux which can take into account the target left boundary being + ! in the interior of the source domain. + fluxR = 0. + h_err = 0. ! For measuring round-off error + jStart = 1 + xStart = 0. + do iTarget = 0,n1 + fluxL = fluxR ! This does nothing for iTarget=0 + + if (iTarget == 0) then + xOld = 0. ! Left boundary is at x=0 + hOld = -1.E30 ! Should not be used for iTarget = 0 + uOld = -1.E30 ! Should not be used for iTarget = 0 + elseif (iTarget <= n0) then + xOld = xOld + h0(iTarget) ! Position of right edge of cell + hOld = h0(iTarget) + uOld = u0(iTarget) + h_err = h_err + epsilon(hOld) * max(hOld, xOld) + else + hOld = 0. ! as if for layers>n0, they were vanished + uOld = 1.E30 ! and the initial value should not matter + endif + xNew = xOld + dx1(iTarget+1) + xL = min( xOld, xNew ) + xR = max( xOld, xNew ) + + ! hFlux is the positive width of the remapped volume + hFlux = abs(dx1(iTarget+1)) + call integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & + xL, xR, hFlux, uAve, jStart, xStart ) + ! uAve is the average value of u, independent of sign of dx1 + fluxR = dx1(iTarget+1)*uAve ! Includes sign of dx1 + + if (iTarget>0) then + hNew = hOld + ( dx1(iTarget+1) - dx1(iTarget) ) + hNew = max( 0., hNew ) + uhNew = ( uOld * hOld ) + ( fluxR - fluxL ) + if (hNew>0.) then + u1(iTarget) = uhNew / hNew + else + u1(iTarget) = uAve + endif + if (present(h1)) h1(iTarget) = hNew + endif + + enddo ! end iTarget loop on target grid cells + +end subroutine remapByDeltaZ + +!> Integrate the reconstructed column profile over a single cell +subroutine integrateReconOnInterval( n0, h0, u0, ppoly0_E, ppoly0_coefs, method, & + xL, xR, hC, uAve, jStart, xStart, h_neglect ) + integer, intent(in) :: n0 !< Number of cells in source grid + real, dimension(:), intent(in) :: h0 !< Source grid sizes (size n0) + real, dimension(:), intent(in) :: u0 !< Source cell averages + real, dimension(:,:), intent(in) :: ppoly0_E !< Edge value of polynomial + real, dimension(:,:), intent(in) :: ppoly0_coefs !< Coefficients of polynomial + integer, intent(in) :: method !< Remapping scheme to use + real, intent(in) :: xL !< Left edges of target cell + real, intent(in) :: xR !< Right edges of target cell + real, intent(in) :: hC !< Cell width hC = xR - xL + real, intent(out) :: uAve !< Average value on target cell + integer, intent(inout) :: jStart !< The index of the cell to start searching from + !< On exit, contains index of last cell used + real, intent(inout) :: xStart !< The left edge position of cell jStart + !< On first entry should be 0. + real, optional, intent(in) :: h_neglect !< A negligibly small width for the + !! purpose of cell reconstructions + !! in the same units as h + ! Local variables + integer :: j, k + integer :: jL, jR ! indexes of source cells containing target + ! cell edges + real :: q ! complete integration + real :: xi0, xi1 ! interval of integration (local -- normalized + ! -- coordinates) + real :: x0jLl, x0jLr ! Left/right position of cell jL + real :: x0jRl, x0jRr ! Left/right position of cell jR + real :: hAct ! The distance actually used in the integration + ! (notionally xR - xL) which differs due to roundoff. + real :: x0_2, x1_2, x02px12, x0px1 ! Used in evaluation of integrated polynomials + real :: hNeglect ! A negligible thickness in the same units as h + real, parameter :: r_3 = 1.0/3.0 ! Used in evaluation of integrated polynomials + + hNeglect = hNeglect_dflt ; if (present(h_neglect)) hNeglect = h_neglect + + q = -1.E30 + x0jLl = -1.E30 + x0jRl = -1.E30 + + ! Find the left most cell in source grid spanned by the target cell + jL = -1 + x0jLr = xStart + do j = jStart, n0 + x0jLl = x0jLr + x0jLr = x0jLl + h0(j) + ! Left edge is found in cell j + if ( ( xL >= x0jLl ) .AND. ( xL <= x0jLr ) ) then + jL = j + exit ! once target grid cell is found, exit loop + endif + enddo + jStart = jL + xStart = x0jLl + +! ! HACK to handle round-off problems. Need only at j=n0. +! ! This moves the effective cell boundary outwards a smidgen. +! if (xL>x0jLr) x0jLr = xL + + ! If, at this point, jL is equal to -1, it means the vanished + ! cell lies outside the source grid. In other words, it means that + ! the source and target grids do not cover the same physical domain + ! and there is something very wrong ! + if ( jL == -1 ) call MOM_error(FATAL, & + 'MOM_remapping, integrateReconOnInterval: '//& + 'The location of the left-most cell could not be found') + + + ! ============================================================ + ! Check whether target cell is vanished. If it is, the cell + ! average is simply the interpolated value at the location + ! of the vanished cell. If it isn't, we need to integrate the + ! quantity within the cell and divide by the cell width to + ! determine the cell average. + ! ============================================================ + ! 1. Cell is vanished + !if ( abs(xR - xL) <= epsilon(xR)*max(abs(xR),abs(xL)) ) then + if ( abs(xR - xL) == 0.0 ) then + + ! We check whether the source cell (i.e. the cell in which the + ! vanished target cell lies) is vanished. If it is, the interpolated + ! value is set to be mean of the edge values (which should be the same). + ! If it isn't, we simply interpolate. + if ( h0(jL) == 0.0 ) then + uAve = 0.5 * ( ppoly0_E(jL,1) + ppoly0_E(jL,2) ) + else + !### WHY IS THIS NOT WRITTEN AS xi0 = ( xL - x0jLl ) / h0(jL) ---AJA + xi0 = xL / ( h0(jL) + hNeglect ) - x0jLl / ( h0(jL) + hNeglect ) + + select case ( method ) + case ( INTEGRATION_PCM ) + uAve = ppoly0_coefs(jL,1) + case ( INTEGRATION_PLM ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ppoly0_coefs(jL,2) + case ( INTEGRATION_PPM ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ( ppoly0_coefs(jL,2) & + + xi0 * ppoly0_coefs(jL,3) ) + case ( INTEGRATION_PQM ) + uAve = ppoly0_coefs(jL,1) & + + xi0 * ( ppoly0_coefs(jL,2) & + + xi0 * ( ppoly0_coefs(jL,3) & + + xi0 * ( ppoly0_coefs(jL,4) & + + xi0 * ppoly0_coefs(jL,5) ) ) ) + case default + call MOM_error( FATAL,'The selected integration method is invalid' ) + end select + + endif ! end checking whether source cell is vanished + + ! 2. Cell is not vanished + else + + ! Find the right most cell in source grid spanned by the target cell + jR = -1 + x0jRr = xStart + do j = jStart,n0 + x0jRl = x0jRr + x0jRr = x0jRl + h0(j) + ! Right edge is found in cell j + if ( ( xR >= x0jRl ) .AND. ( xR <= x0jRr ) ) then + jR = j + exit ! once target grid cell is found, exit loop + endif + enddo ! end loop on source grid cells + + ! If xR>x0jRr then the previous loop reached j=n0 and the target + ! position, xR, was beyond the right edge of the source grid (h0). + ! This can happen due to roundoff, in which case we set jR=n0. + if (xR>x0jRr) jR = n0 + + ! To integrate, two cases must be considered: (1) the target cell is + ! entirely contained within a cell of the source grid and (2) the target + ! cell spans at least two cells of the source grid. + + if ( jL == jR ) then + ! The target cell is entirely contained within a cell of the source + ! grid. This situation is represented by the following schematic, where + ! the cell in which xL and xR are located has index jL=jR : + ! + ! ----|-----o--------o----------|------------- + ! xL xR + ! + ! Determine normalized coordinates +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) + xi1 = max( 0., min( 1., ( xR - x0jLl ) / ( h0(jL) + hNeglect ) ) ) +#else + xi0 = xL / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) + xi1 = xR / h0(jL) - x0jLl / ( h0(jL) + hNeglect ) +#endif + + hAct = h0(jL) * ( xi1 - xi0 ) + + ! Depending on which polynomial is used, integrate quantity + ! between xi0 and xi1. Integration is carried out in normalized + ! coordinates, hence: \int_xL^xR p(x) dx = h \int_xi0^xi1 p(xi) dxi + select case ( method ) + case ( INTEGRATION_PCM ) + q = ( xR - xL ) * ppoly0_coefs(jL,1) + case ( INTEGRATION_PLM ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) + case ( INTEGRATION_PPM ) + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + case ( INTEGRATION_PQM ) + x0_2 = xi0*xi0 + x1_2 = xi1*xi1 + x02px12 = x0_2 + x1_2 + x0px1 = xi1 + xi0 + q = ( xR - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + case default + call MOM_error( FATAL,'The selected integration method is invalid' ) + end select + + else + ! The target cell spans at least two cells of the source grid. + ! This situation is represented by the following schematic, where + ! the cells in which xL and xR are located have indexes jL and jR, + ! respectively : + ! + ! ----|-----o---|--- ... --|---o----------|------------- + ! xL xR + ! + ! We first integrate from xL up to the right boundary of cell jL, then + ! add the integrated amounts of cells located between jL and jR and then + ! integrate from the left boundary of cell jR up to xR + + q = 0.0 + + ! Integrate from xL up to right boundary of cell jL +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + xi0 = max( 0., min( 1., ( xL - x0jLl ) / ( h0(jL) + hNeglect ) ) ) +#else + xi0 = (xL - x0jLl) / ( h0(jL) + hNeglect ) +#endif + xi1 = 1.0 + + hAct = h0(jL) * ( xi1 - xi0 ) + + select case ( method ) + case ( INTEGRATION_PCM ) + q = q + ( x0jLr - xL ) * ppoly0_coefs(jL,1) + case ( INTEGRATION_PLM ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) ) + case ( INTEGRATION_PPM ) + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jL,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + case ( INTEGRATION_PQM ) + x0_2 = xi0*xi0 + x1_2 = xi1*xi1 + x02px12 = x0_2 + x1_2 + x0px1 = xi1 + xi0 + q = q + ( x0jLr - xL ) * ( & + ppoly0_coefs(jL,1) & + + ( ppoly0_coefs(jL,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jL,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jL,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jL,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + case default + call MOM_error( FATAL, 'The selected integration method is invalid' ) + end select + + ! Integrate contents within cells strictly comprised between jL and jR + if ( jR > (jL+1) ) then + do k = jL+1,jR-1 + q = q + h0(k) * u0(k) + hAct = hAct + h0(k) + enddo + endif + + ! Integrate from left boundary of cell jR up to xR + xi0 = 0.0 +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ + xi1 = max( 0., min( 1., ( xR - x0jRl ) / ( h0(jR) + hNeglect ) ) ) +#else + xi1 = (xR - x0jRl) / ( h0(jR) + hNeglect ) +#endif + + hAct = hAct + h0(jR) * ( xi1 - xi0 ) + + select case ( method ) + case ( INTEGRATION_PCM ) + q = q + ( xR - x0jRl ) * ppoly0_coefs(jR,1) + case ( INTEGRATION_PLM ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) ) + case ( INTEGRATION_PPM ) + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & + + ppoly0_coefs(jR,3) * r_3 * ( ( xi1*xi1 + xi0*xi0 ) + xi0*xi1 ) ) ) + case ( INTEGRATION_PQM ) + x0_2 = xi0*xi0 + x1_2 = xi1*xi1 + x02px12 = x0_2 + x1_2 + x0px1 = xi1 + xi0 + q = q + ( xR - x0jRl ) * ( & + ppoly0_coefs(jR,1) & + + ( ppoly0_coefs(jR,2) * 0.5 * ( xi1 + xi0 ) & + + ( ppoly0_coefs(jR,3) * r_3 * ( x02px12 + xi0*xi1 ) & + + ppoly0_coefs(jR,4) * 0.25* ( x02px12 * x0px1 ) & + + ppoly0_coefs(jR,5) * 0.2 * ( ( xi1*x1_2 + xi0*x0_2 ) * x0px1 + x0_2*x1_2 ) ) ) ) + case default + call MOM_error( FATAL,'The selected integration method is invalid' ) + end select + + endif ! end integration for non-vanished cells + + ! The cell average is the integrated value divided by the cell width +#ifdef __USE_ROUNDOFF_SAFE_ADJUSTMENTS__ +if (hAct==0.) then + uAve = ppoly0_coefs(jL,1) +else + uAve = q / hAct +endif +#else + uAve = q / hC +#endif + + endif ! endif clause to check if cell is vanished + +end subroutine integrateReconOnInterval + +!> Calculates the change in interface positions based on h1 and h2 +subroutine dzFromH1H2( n1, h1, n2, h2, dx ) + integer, intent(in) :: n1 !< Number of cells on source grid + real, dimension(:), intent(in) :: h1 !< Cell widths of source grid (size n1) [H] + integer, intent(in) :: n2 !< Number of cells on target grid + real, dimension(:), intent(in) :: h2 !< Cell widths of target grid (size n2) [H] + real, dimension(:), intent(out) :: dx !< Change in interface position (size n2+1) [H] + ! Local variables + integer :: k + real :: x1, x2 ! Interface positions [H] + + x1 = 0. + x2 = 0. + dx(1) = 0. + do K = 1, max(n1,n2) + if (k <= n1) x1 = x1 + h1(k) ! Interface k+1, right of source cell k + if (k <= n2) then + x2 = x2 + h2(k) ! Interface k+1, right of target cell k + dx(K+1) = x2 - x1 ! Change of interface k+1, target - source + endif + enddo + +end subroutine dzFromH1H2 + +!> Calculate edge coordinate x from cell width h +subroutine buildGridFromH(nz, h, x) + integer, intent(in) :: nz !< Number of cells + real, dimension(nz), intent(in) :: h !< Cell widths [H] + real, dimension(nz+1), intent(inout) :: x !< Edge coordinates starting at x(1)=0 [H] + ! Local variables + integer :: k + + x(1) = 0.0 + do k = 1,nz + x(k+1) = x(k) + h(k) + enddo + +end subroutine buildGridFromH + +!> Runs unit tests on archaic remapping functions. +!! Should only be called from a single/root thread +!! Returns True if a test fails, otherwise False +logical function remapping_attic_unit_tests(verbose) + logical, intent(in) :: verbose !< If true, write results to stdout + ! Local variables + integer, parameter :: n0 = 4, n1 = 3, n2 = 6 + real :: h0(n0), x0(n0+1), u0(n0) + real :: h1(n1), x1(n1+1), u1(n1), hn1(n1), dx1(n1+1) + real :: h2(n2), x2(n2+1), u2(n2), hn2(n2), dx2(n2+1) + data u0 /9., 3., -3., -9./ ! Linear profile, 4 at surface to -4 at bottom + data h0 /4*0.75/ ! 4 uniform layers with total depth of 3 + data h1 /3*1./ ! 3 uniform layers with total depth of 3 + data h2 /6*0.5/ ! 6 uniform layers with total depth of 3 + real, allocatable, dimension(:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs + integer :: answer_date ! The vintage of the expressions to test + integer :: i, degree + real :: err, h_neglect, h_neglect_edge + logical :: thisTest, v + + v = verbose + answer_date = 20190101 ! 20181231 + h_neglect = hNeglect_dflt + h_neglect_edge = hNeglect_dflt ; if (answer_date < 20190101) h_neglect_edge = 1.0e-10 + + write(stdout,*) '==== remapping_attic: remapping_attic_unit_tests =================' + remapping_attic_unit_tests = .false. ! Normally return false + + call buildGridFromH(n0, h0, x0) + call buildGridFromH(n1, h1, x1) + + thisTest = .false. + degree = 2 + if (verbose) write(stdout,*) 'h0 (test data)' + if (verbose) call dumpGrid(n0,h0,x0,u0) + + call dzFromH1H2( n0, h0, n1, h1, dx1 ) + + thisTest = .false. + allocate(ppoly0_E(n0,2)) + allocate(ppoly0_S(n0,2)) + allocate(ppoly0_coefs(n0,degree+1)) + + ppoly0_E(:,:) = 0.0 + ppoly0_S(:,:) = 0.0 + ppoly0_coefs(:,:) = 0.0 + + call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect=1e-10, answer_date=answer_date ) + call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect, answer_date=answer_date ) + call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect ) + u1(:) = 0. + call remapByProjection( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n1, h1, INTEGRATION_PPM, u1, h_neglect ) + do i=1,n1 + err = u1(i)-8.*(0.5*real(1+n1)-real(i)) + if (abs(err)>2.*epsilon(err)) thisTest = .true. + enddo + if (thisTest) write(stdout,*) 'remapping_attic_unit_tests: Failed remapByProjection()' + remapping_attic_unit_tests = remapping_attic_unit_tests .or. thisTest + + thisTest = .false. + u1(:) = 0. + call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n1, x1-x0(1:n1+1), & + INTEGRATION_PPM, u1, hn1, h_neglect ) + if (verbose) write(stdout,*) 'h1 (by delta)' + if (verbose) call dumpGrid(n1,h1,x1,u1) + hn1 = hn1-h1 + do i=1,n1 + err = u1(i)-8.*(0.5*real(1+n1)-real(i)) + if (abs(err)>2.*epsilon(err)) thisTest = .true. + enddo + if (thisTest) write(stdout,*) 'remapping_attic_unit_tests: Failed remapByDeltaZ() 1' + remapping_attic_unit_tests = remapping_attic_unit_tests .or. thisTest + + thisTest = .false. + call buildGridFromH(n2, h2, x2) + dx2(1:n0+1) = x2(1:n0+1) - x0 + dx2(n0+2:n2+1) = x2(n0+2:n2+1) - x0(n0+1) + call remapByDeltaZ( n0, h0, u0, ppoly0_E, ppoly0_coefs, & + n2, dx2, & + INTEGRATION_PPM, u2, hn2, h_neglect ) + if (verbose) write(stdout,*) 'h2' + if (verbose) call dumpGrid(n2,h2,x2,u2) + if (verbose) write(stdout,*) 'hn2' + if (verbose) call dumpGrid(n2,hn2,x2,u2) + + do i=1,n2 + err = u2(i)-8./2.*(0.5*real(1+n2)-real(i)) + if (abs(err)>2.*epsilon(err)) thisTest = .true. + enddo + if (thisTest) write(stdout,*) 'remapping_attic_unit_tests: Failed remapByDeltaZ() 2' + remapping_attic_unit_tests = remapping_attic_unit_tests .or. thisTest + + if (.not. remapping_attic_unit_tests) write(stdout,*) 'Pass' + +end function remapping_attic_unit_tests + +!> Convenience function for printing grid to screen +subroutine dumpGrid(n,h,x,u) + integer, intent(in) :: n !< Number of cells + real, dimension(:), intent(in) :: h !< Cell thickness [H] + real, dimension(:), intent(in) :: x !< Interface delta [H] + real, dimension(:), intent(in) :: u !< Cell average values [A] + integer :: i + write(stdout,'("i=",20i10)') (i,i=1,n+1) + write(stdout,'("x=",20es10.2)') (x(i),i=1,n+1) + write(stdout,'("i=",5x,20i10)') (i,i=1,n) + write(stdout,'("h=",5x,20es10.2)') (h(i),i=1,n) + write(stdout,'("u=",5x,20es10.2)') (u(i),i=1,n) +end subroutine dumpGrid + +end module remapping_attic diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 54d2310cfe..ba7152ea30 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -74,7 +74,7 @@ module MOM use MOM_dynamics_unsplit, only : MOM_dyn_unsplit_CS use MOM_dynamics_split_RK2, only : step_MOM_dyn_split_RK2, register_restarts_dyn_split_RK2 use MOM_dynamics_split_RK2, only : initialize_dyn_split_RK2, end_dyn_split_RK2 -use MOM_dynamics_split_RK2, only : MOM_dyn_split_RK2_CS +use MOM_dynamics_split_RK2, only : MOM_dyn_split_RK2_CS, remap_dyn_split_rk2_aux_vars use MOM_dynamics_unsplit_RK2, only : step_MOM_dyn_unsplit_RK2, register_restarts_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : initialize_dyn_unsplit_RK2, end_dyn_unsplit_RK2 use MOM_dynamics_unsplit_RK2, only : MOM_dyn_unsplit_RK2_CS @@ -103,19 +103,19 @@ module MOM use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics use MOM_open_boundary, only : ocean_OBC_type, OBC_registry_type -use MOM_open_boundary, only : register_temp_salt_segments -use MOM_open_boundary, only : open_boundary_register_restarts -use MOM_open_boundary, only : update_segment_tracer_reservoirs +use MOM_open_boundary, only : register_temp_salt_segments, update_segment_tracer_reservoirs +use MOM_open_boundary, only : open_boundary_register_restarts, remap_OBC_fields use MOM_open_boundary, only : rotate_OBC_config, rotate_OBC_init use MOM_porous_barriers, only : porous_widths_layer, porous_widths_interface, porous_barriers_init use MOM_porous_barriers, only : porous_barrier_CS -use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML -use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS +use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS +use MOM_set_visc, only : set_visc_register_restarts, remap_vertvisc_aux_vars use MOM_set_visc, only : set_visc_init, set_visc_end use MOM_shared_initialization, only : write_ocean_geometry_file use MOM_sponge, only : init_sponge_diags, sponge_CS use MOM_state_initialization, only : MOM_initialize_state -use MOM_stoch_eos, only : MOM_stoch_eos_init,MOM_stoch_eos_run,MOM_stoch_eos_CS,mom_calc_varT +use MOM_stoch_eos, only : MOM_stoch_eos_init, MOM_stoch_eos_run, MOM_stoch_eos_CS +use MOM_stoch_eos, only : stoch_EOS_register_restarts, post_stoch_EOS_diags, mom_calc_varT use MOM_sum_output, only : write_energy, accumulate_net_input use MOM_sum_output, only : MOM_sum_output_init, MOM_sum_output_end use MOM_sum_output, only : sum_output_CS @@ -133,7 +133,7 @@ module MOM use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state -use MOM_tracer_flow_control, only : tracer_flow_control_end +use MOM_tracer_flow_control, only : tracer_flow_control_end, call_tracer_register_obc_segments use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling @@ -250,6 +250,10 @@ 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 :: remap_aux_vars !< If true, apply ALE remapping to all of the auxiliary 3-D + !! variables that are needed to reproduce across restarts, + !! similarly to what is done with the primary state variables. + type(MOM_stoch_eos_CS) :: stoch_eos_CS !< structure containing random pattern for stoch EOS logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction !! updates occur first in directionally split parts of the calculation. @@ -285,16 +289,24 @@ module MOM logical :: thickness_diffuse_first !< If true, diffuse thickness before dynamics. logical :: mixedlayer_restrat !< If true, use submesoscale mixed layer restratifying scheme. logical :: useMEKE !< If true, call the MEKE parameterization. + logical :: use_stochastic_EOS !< If true, use the stochastic EOS parameterizations. logical :: useWaves !< If true, update Stokes drift logical :: use_p_surf_in_EOS !< If true, always include the surface pressure contributions !! in equation of state calculations. logical :: use_diabatic_time_bug !< If true, uses the wrong calendar time for diabatic processes, !! as was done in MOM6 versions prior to February 2018. real :: dtbt_reset_period !< The time interval between dynamic recalculation of the - !! barotropic time step [s]. If this is negative dtbt is never + !! barotropic time step [T ~> s]. If this is negative dtbt is never !! calculated, and if it is 0, dtbt is calculated every step. type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. - type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. + type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. + real :: dt_obc_seg_period !< The time interval between OBC segment updates for OBGC + !! tracers [T ~> s], or a negative value if the segment + !! data are time-invarant, or zero to update the OBGC + !! segment data with every call to update_OBC_segment_data. + type(time_type) :: dt_obc_seg_interval !< A time_time representation of dt_obc_seg_period. + type(time_type) :: dt_obc_seg_time !< The next time OBC segment update is applied to OBGC tracers. + real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied !! by ice shelf [nondim] real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2] @@ -474,7 +486,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS !! tracer and mass exchange forcing fields 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]. + real, intent(in) :: time_int_in !< time interval covered by this run segment [T ~> s]. 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 @@ -489,7 +501,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS !! treated as the last call to step_MOM in a !! time-stepping cycle; missing is like true. real, optional, intent(in) :: cycle_length !< The amount of time in a coupled time - !! stepping cycle [s]. + !! stepping cycle [T ~> s]. logical, optional, intent(in) :: reset_therm !< This indicates whether the running sums of !! thermodynamic quantities should be reset. !! If missing, this is like start_cycle. @@ -559,14 +571,14 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB u => CS%u ; v => CS%v ; h => CS%h - time_interval = US%s_to_T*time_int_in + time_interval = time_int_in do_dyn = .true. ; if (present(do_dynamics)) do_dyn = do_dynamics do_thermo = .true. ; if (present(do_thermodynamics)) do_thermo = do_thermodynamics if (.not.(do_dyn .or. do_thermo)) call MOM_error(FATAL,"Step_MOM: "//& "Both do_dynamics and do_thermodynamics are false, which makes no sense.") cycle_start = .true. ; if (present(start_cycle)) cycle_start = start_cycle cycle_end = .true. ; if (present(end_cycle)) cycle_end = end_cycle - cycle_time = time_interval ; if (present(cycle_length)) cycle_time = US%s_to_T*cycle_length + cycle_time = time_interval ; if (present(cycle_length)) cycle_time = cycle_length therm_reset = cycle_start ; if (present(reset_therm)) therm_reset = reset_therm call cpu_clock_begin(id_clock_ocean) @@ -622,7 +634,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ntstep = floor(dt_therm/dt + 0.001) elseif (.not.do_thermo) then dt_therm = CS%dt_therm - if (present(cycle_length)) dt_therm = min(CS%dt_therm, US%s_to_T*cycle_length) + if (present(cycle_length)) dt_therm = min(CS%dt_therm, cycle_length) ! ntstep is not used. else ntstep = MAX(1, MIN(n_max, floor(CS%dt_therm/dt + 0.001))) @@ -718,9 +730,10 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%debug) then if (cycle_start) & call MOM_state_chksum("Before steps ", u, v, h, CS%uh, CS%vh, G, GV, US) - if (cycle_start) call check_redundant("Before steps ", u, v, G) + if (cycle_start) call check_redundant("Before steps ", u, v, G, unscale=US%L_T_to_m_s) if (do_dyn) call MOM_mech_forcing_chksum("Before steps", forces, G, US, haloshift=0) - if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G) + if (do_dyn) call check_redundant("Before steps ", forces%taux, forces%tauy, G, & + unscale=US%RZ_T_to_kg_m2s*US%L_T_to_m_s) endif call cpu_clock_end(id_clock_other) @@ -1072,12 +1085,12 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call cpu_clock_begin(id_clock_dynamics) call cpu_clock_begin(id_clock_stoch) - if (CS%stoch_eos_CS%use_stoch_eos) call MOM_stoch_eos_run(G,u,v,dt,Time_local,CS%stoch_eos_CS,CS%diag) + if (CS%use_stochastic_EOS) call MOM_stoch_eos_run(G, u, v, dt, Time_local, CS%stoch_eos_CS) call cpu_clock_end(id_clock_stoch) call cpu_clock_begin(id_clock_varT) - if (CS%stoch_eos_CS%stanley_coeff >= 0.0) then - call MOM_calc_varT(G,GV,h,CS%tv,CS%stoch_eos_CS,dt) - call pass_var(CS%tv%varT, G%Domain,clock=id_clock_pass,halo=1) + if (CS%use_stochastic_EOS) then + call MOM_calc_varT(G, GV, h, CS%tv, CS%stoch_eos_CS, dt) + if (associated(CS%tv%varT)) call pass_var(CS%tv%varT, G%Domain, clock=id_clock_pass, halo=1) endif call cpu_clock_end(id_clock_varT) @@ -1132,6 +1145,17 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call disable_averaging(CS%diag) endif + !OBC segment data update for some fields can be less frequent than others + if(associated(CS%OBC)) then + CS%OBC%update_OBC_seg_data = .false. + if (CS%dt_obc_seg_period == 0.0) CS%OBC%update_OBC_seg_data = .true. + if (CS%dt_obc_seg_period > 0.0) then + if (Time_local >= CS%dt_obc_seg_time) then + CS%OBC%update_OBC_seg_data = .true. + CS%dt_obc_seg_time = CS%dt_obc_seg_time + CS%dt_obc_seg_interval + endif + endif + endif if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, @@ -1279,9 +1303,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & if (IDs%id_u > 0) call post_data(IDs%id_u, u, CS%diag) if (IDs%id_v > 0) call post_data(IDs%id_v, v, CS%diag) if (IDs%id_h > 0) call post_data(IDs%id_h, h, CS%diag) - if (CS%stoch_eos_CS%id_stoch_eos > 0) call post_data(CS%stoch_eos_CS%id_stoch_eos, CS%stoch_eos_CS%pattern, CS%diag) - if (CS%stoch_eos_CS%id_stoch_phi > 0) call post_data(CS%stoch_eos_CS%id_stoch_phi, CS%stoch_eos_CS%phi, CS%diag) - if (CS%stoch_eos_CS%id_tvar_sgs > 0) call post_data(CS%stoch_eos_CS%id_tvar_sgs, CS%tv%varT, CS%diag) + if (CS%use_stochastic_EOS) call post_stoch_EOS_diags(CS%stoch_eos_CS, CS%tv, CS%diag) call disable_averaging(CS%diag) call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other) @@ -1435,7 +1457,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & 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) + call apply_oda_tracer_increments(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 @@ -1477,7 +1499,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & haloshift=0, scale=GV%H_to_m*US%L_to_m**2) ! call MOM_state_chksum("Pre-diabatic ", u, v, h, CS%uhtr, CS%vhtr, G, GV, vel_scale=1.0) call MOM_thermo_chksum("Pre-diabatic ", tv, G, US, haloshift=0) - call check_redundant("Pre-diabatic ", u, v, G) + call check_redundant("Pre-diabatic ", u, v, G, unscale=US%L_T_to_m_s) call MOM_forcing_chksum("Pre-diabatic", fluxes, G, US, haloshift=0) endif @@ -1507,10 +1529,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) if (CS%debug) then - call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) - call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) - call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) - call check_redundant("Pre-ALE ", u, v, G) + call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, omit_corners=.true.) + call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, omit_corners=.true., scale=US%C_to_degC) + call hchksum(tv%S,"Pre-ALE S", G%HI, haloshift=1, omit_corners=.true., scale=US%S_to_ppt) + call check_redundant("Pre-ALE ", u, v, G, unscale=US%L_T_to_m_s) endif call cpu_clock_begin(id_clock_ALE) @@ -1532,6 +1554,16 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call ALE_remap_tracers(CS%ALE_CSp, G, GV, h, h_new, CS%tracer_Reg, showCallTree, dtdia, PCM_cell) call ALE_remap_velocities(CS%ALE_CSp, G, GV, h, h_new, u, v, CS%OBC, dzRegrid, showCallTree, dtdia) + if (CS%remap_aux_vars) then + if (CS%split) & + call remap_dyn_split_RK2_aux_vars(G, GV, CS%dyn_split_RK2_CSp, h, h_new, CS%ALE_CSp, CS%OBC, dzRegrid) + + if (associated(CS%OBC)) & + call remap_OBC_fields(G, GV, h, h_new, CS%OBC, PCM_cell=PCM_cell) + + call remap_vertvisc_aux_vars(G, GV, CS%visc, h, h_new, CS%ALE_CSp, CS%OBC) + endif + ! Replace the old grid with new one. All remapping must be done by this point in the code. !$OMP parallel do default(shared) do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 @@ -1555,7 +1587,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call MOM_state_chksum("Post-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US) call hchksum(tv%T, "Post-ALE T", G%HI, haloshift=1, scale=US%C_to_degC) call hchksum(tv%S, "Post-ALE S", G%HI, haloshift=1, scale=US%S_to_ppt) - call check_redundant("Post-ALE ", u, v, G) + call check_redundant("Post-ALE ", u, v, G, unscale=US%L_T_to_m_s) endif ! Whenever thickness changes let the diag manager know, target grids @@ -1580,7 +1612,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) - call check_redundant("Post-diabatic ", u, v, G) + call check_redundant("Post-diabatic ", u, v, G, unscale=US%L_T_to_m_s) endif call disable_averaging(CS%diag) @@ -1621,7 +1653,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(forcing), intent(inout) :: fluxes !< pointers to forcing fields 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 [s] + real, intent(in) :: time_interval !< time interval [T ~> s] type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM ! Local pointers @@ -1667,9 +1699,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call cpu_clock_begin(id_clock_offline_tracer) call extract_offline_main(CS%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, & vertical_time, dt_offline, dt_offline_vertical, skip_diffusion) - Time_end = increment_date(Time_start, seconds=floor(time_interval+0.001)) + Time_end = increment_date(Time_start, seconds=floor(US%T_to_s*time_interval+0.001)) - call enable_averaging(time_interval, Time_end, CS%diag) + call enable_averages(time_interval, Time_end, CS%diag) ! Check to see if this is the first iteration of the offline interval first_iter = (accumulated_time == real_to_time(0.0)) @@ -1679,7 +1711,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS if (do_vertical) vertical_time = accumulated_time + real_to_time(US%T_to_s*dt_offline_vertical) ! Increment the amount of time elapsed since last read and check if it's time to roll around - accumulated_time = accumulated_time + real_to_time(time_interval) + accumulated_time = accumulated_time + real_to_time(US%T_to_s*time_interval) last_iter = (accumulated_time >= real_to_time(US%T_to_s*dt_offline)) @@ -1786,7 +1818,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in ! main_offline_advection_layer. Warning: this may not be appropriate for tracers that ! exchange with the atmosphere - if (abs(time_interval - US%T_to_s*dt_offline) > 1.0e-6) then + if (abs(time_interval - dt_offline) > 1.0e-6*US%s_to_T) then call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif @@ -1946,7 +1978,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real :: salin_underflow ! A tiny value of salinity below which the it is set to 0 [S ~> ppt] real :: temp_underflow ! A tiny magnitude of temperatures below which they are set to 0 [C ~> degC] real :: conv2watt ! A conversion factor from temperature fluxes to heat - ! fluxes [J m-2 H-1 degC-1 ~> J m-3 degC-1 or J kg-1 degC-1] + ! fluxes [J m-2 H-1 C-1 ~> J m-3 degC-1 or J kg-1 degC-1] real :: conv2salt ! A conversion factor for salt fluxes [m H-1 ~> 1] or [kg m-2 H-1 ~> 1] real :: RL2_T2_rescale, Z_rescale, QRZ_rescale ! Unit conversion factors character(len=48) :: S_flux_units @@ -2059,6 +2091,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm, & "If True, use the ALE algorithm (regridding/remapping). "//& "If False, use the layered isopycnal algorithm.", default=.false. ) + call get_param(param_file, "MOM", "REMAP_AUXILIARY_VARS", CS%remap_aux_vars, & + "If true, apply ALE remapping to all of the auxiliary 3-dimensional "//& + "variables that are needed to reproduce across restarts, similarly to "//& + "what is already being done with the primary state variables. "//& + "The default should be changed to true.", default=.false., & + do_not_log=.not.CS%use_ALE_algorithm) call get_param(param_file, "MOM", "BULKMIXEDLAYER", bulkmixedlayer, & "If true, use a Kraus-Turner-like bulk mixed layer "//& "with transitional buffer layers. Layers 1 through "//& @@ -2142,7 +2180,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "at the end of the step.", default=.false.) if (CS%split) then - call get_param(param_file, "MOM", "DTBT", dtbt, default=-0.98) + call get_param(param_file, "MOM", "DTBT", dtbt, units="s or nondim", default=-0.98) default_val = US%T_to_s*CS%dt_therm ; if (dtbt > 0.0) default_val = -1.0 CS%dtbt_reset_period = -1.0 call get_param(param_file, "MOM", "DTBT_RESET_PERIOD", CS%dtbt_reset_period, & @@ -2151,9 +2189,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "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.", & - units="s", default=default_val, do_not_read=(dtbt > 0.0)) + units="s", default=default_val, scale=US%s_to_T, do_not_read=(dtbt > 0.0)) endif + call get_param(param_file, "MOM", "DT_OBC_SEG_UPDATE_OBGC", CS%dt_obc_seg_period, & + "The time between OBC segment data updates for OBGC tracers. "//& + "This must be an integer multiple of DT and DT_THERM. "//& + "The default is set to DT.", & + units="s", default=US%T_to_s*CS%dt, scale=US%s_to_T, do_not_log=.not.associated(CS%OBC)) + ! This is here in case these values are used inappropriately. use_frazil = .false. ; bound_salinity = .false. CS%tv%P_Ref = 2.0e7*US%kg_m3_to_R*US%m_s_to_L_T**2 @@ -2180,11 +2224,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "A tiny magnitude of temperatures below which they are set to 0.", & units="degC", default=0.0, scale=US%degC_to_C) call get_param(param_file, "MOM", "C_P", CS%tv%C_p, & - "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.", units="J kg-1 K-1", & - default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC) + "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.", & + units="J kg-1 K-1", default=3991.86795711963, scale=US%J_kg_to_Q*US%C_to_degC) call get_param(param_file, "MOM", "USE_PSURF_IN_EOS", CS%use_p_surf_in_EOS, & "If true, always include the surface pressure contributions "//& "in equation of state calculations.", default=.true.) @@ -2200,9 +2243,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The number of sublayers within the mixed layer if "//& "BULKMIXEDLAYER is true.", units="nondim", default=2) call get_param(param_file, "MOM", "NKBL", nkbl, & - "The number of layers that are used as variable density "//& - "buffer layers if BULKMIXEDLAYER is true.", units="nondim", & - default=2) + "The number of layers that are used as variable density buffer "//& + "layers if BULKMIXEDLAYER is true.", units="nondim", default=2) endif call get_param(param_file, "MOM", "GLOBAL_INDEXING", global_indexing, & @@ -2598,12 +2640,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(HI, GV, US, param_file, CS%tracer_flow_CSp, & + call call_tracer_register(G, GV, US, param_file, CS%tracer_flow_CSp, & CS%tracer_Reg, restart_CSp) call MEKE_alloc_register_restart(HI, US, param_file, CS%MEKE, restart_CSp) call set_visc_register_restarts(HI, GV, US, param_file, CS%visc, restart_CSp) - call mixedlayer_restrat_register_restarts(HI, GV, param_file, & + call mixedlayer_restrat_register_restarts(HI, GV, US, param_file, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%rotate_index .and. associated(OBC_in) .and. use_temperature) then @@ -2622,13 +2664,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & 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) + call call_OBC_register(G, GV, US, param_file, CS%update_OBC_CSp, 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, US, CS%OBC, CS%tracer_Reg, param_file) + !This is the equivalent call to register_temp_salt_segments for external tracers with OBC + call call_tracer_register_obc_segments(GV, param_file, CS%tracer_flow_CSp, CS%tracer_Reg, CS%OBC) ! This needs the number of tracers and to have called any code that sets whether ! reservoirs are used. @@ -2637,7 +2681,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif if (present(waves_CSp)) then - call waves_register_restarts(waves_CSp, HI, GV, param_file, restart_CSp) + call waves_register_restarts(waves_CSp, HI, GV, US, param_file, restart_CSp) + endif + + if (use_temperature) then + call stoch_EOS_register_restarts(HI, param_file, CS%stoch_eos_CS, restart_CSp) endif call callTree_waypoint("restart registration complete (initialize_MOM)") @@ -2925,7 +2973,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call interface_filter_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%interface_filter_CSp) new_sim = is_new_run(restart_CSp) - call MOM_stoch_eos_init(G,Time,param_file,CS%stoch_eos_CS,restart_CSp,diag) + if (use_temperature) then + CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, US, param_file, diag, CS%stoch_eos_CS, restart_CSp) + else + CS%use_stochastic_EOS = .false. + endif if (CS%use_porbar) & call porous_barriers_init(Time, US, param_file, diag, CS%por_bar_CS) @@ -2939,7 +2991,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, & CS%visc, dirs, CS%ntrunc, CS%pbv, calc_dtbt=calc_dtbt, cont_stencil=CS%cont_stencil) if (CS%dtbt_reset_period > 0.0) then - CS%dtbt_reset_interval = real_to_time(CS%dtbt_reset_period) + CS%dtbt_reset_interval = real_to_time(US%T_to_s*CS%dtbt_reset_period) ! Set dtbt_reset_time to be the next even multiple of dtbt_reset_interval. CS%dtbt_reset_time = Time_init + CS%dtbt_reset_interval * & ((Time - Time_init) / CS%dtbt_reset_interval) @@ -2964,6 +3016,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%ntrunc, cont_stencil=CS%cont_stencil) endif + !Set OBC segment data update period + if (associated(CS%OBC) .and. CS%dt_obc_seg_period > 0.0) then + CS%dt_obc_seg_interval = real_to_time(US%T_to_s*CS%dt_obc_seg_period) + CS%dt_obc_seg_time = Time + CS%dt_obc_seg_interval + endif + call callTree_waypoint("dynamics initialized (initialize_MOM)") CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & @@ -3162,7 +3220,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing ! various unit conversion factors type(MOM_restart_CS), pointer :: restart_CSp_tmp => NULL() - real, allocatable :: z_interface(:,:,:) ! Interface heights [m] + real, allocatable :: z_interface(:,:,:) ! Interface heights [Z ~> m] call cpu_clock_begin(id_clock_init) call callTree_enter("finish_MOM_initialization()") @@ -3185,9 +3243,9 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) 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, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, z_interface, dZref=G%Z_ref) call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, & - "Interface heights", "meter", z_grid='i') + "Interface heights", "meter", z_grid='i', conversion=US%Z_to_m) ! NOTE: write_ic=.true. routes routine to fms2 IO write_initial_conditions interface call save_restart(dirs%output_directory, Time, CS%G_in, & restart_CSp_tmp, filename=CS%IC_file, GV=GV, write_ic=.true.) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 3289786fd0..056b171ba8 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -189,12 +189,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: & PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: CAuS ! - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: CAvS ! - real :: fv1, fv2, fv3, fv4 ! (f+rv)*v [L T-2 ~> m s-2]. - real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u [L T-2 ~> m s-2]. - real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis - real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: CAuS ! Stokes contribution to CAu [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: CAvS ! Stokes contribution to CAv [L T-2 ~> m s-2] + real :: fv1, fv2, fv3, fv4 ! (f+rv)*v at the 4 points surrounding a u points[L T-2 ~> m s-2] + real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u at the 4 points surrounding a v point [L T-2 ~> m s-2] + real :: max_fv, max_fu ! The maximum of the neighboring Coriolis accelerations [L T-2 ~> m s-2] + real :: min_fv, min_fu ! The minimum of the neighboring Coriolis accelerations [L T-2 ~> m s-2] real, parameter :: C1_12 = 1.0 / 12.0 ! C1_12 = 1/12 [nondim] real, parameter :: C1_24 = 1.0 / 24.0 ! C1_24 = 1/24 [nondim] @@ -1212,11 +1212,11 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_CAuS = register_diag_field('ocean_model', 'CAu_Stokes', diag%axesCuL, Time, & - 'Zonal Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) + 'Zonal Acceleration from Stokes Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) ! add to AD CS%id_CAvS = register_diag_field('ocean_model', 'CAv_Stokes', diag%axesCvL, Time, & - 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2) + 'Meridional Acceleration from Stokes Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) ! add to AD !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & @@ -1249,14 +1249,14 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) !CS%id_hf_rvxu = register_diag_field('ocean_model', 'hf_rvxu', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxu_2d = register_diag_field('ocean_model', 'hf_rvxu_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxv_2d = register_diag_field('ocean_model', 'hf_rvxv_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index a35effa5c0..dfacb40001 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -13,7 +13,7 @@ module MOM_PressureForce_FV use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_domain use MOM_density_integrals, only : int_density_dz, int_specific_vol_dp use MOM_density_integrals, only : int_density_dz_generic_plm, int_density_dz_generic_ppm use MOM_density_integrals, only : int_spec_vol_dp_generic_plm @@ -477,12 +477,11 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm T_t, T_b ! Top and bottom edge values for linear reconstructions ! of temperature within each layer [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - rho_pgf, rho_stanley_pgf ! Density [kg m-3] from EOS with and without SGS T variance - ! in Stanley parameterization. + rho_pgf, rho_stanley_pgf ! Density [R ~> kg m-3] from EOS with and without SGS T variance + ! in Stanley parameterization. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - p_stanley ! Pressure [Pa] estimated with Rho_0 - real :: rho_stanley_scalar ! Scalar quantity to hold density [kg m-3] in Stanley diagnostics. - real :: p_stanley_scalar ! Scalar quantity to hold pressure [Pa] in Stanley diagnostics. + p_stanley ! Pressure [R L2 T-2 ~> Pa] estimated with Rho_0 + real :: zeros(SZI_(G)) ! An array of zero values that can be used as an argument [various] real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate ! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar). @@ -493,12 +492,15 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm real :: G_Rho0 ! G_Earth / Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. real :: rho_ref ! The reference density [R ~> kg m-3]. real :: dz_neglect ! A minimal thickness [Z ~> m], like e. + real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure + ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. logical :: use_p_atm ! If true, use the atmospheric pressure. logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. real, parameter :: C1_6 = 1.0/6.0 ! [nondim] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer, dimension(2) :: EOSdom_h ! The i-computational domain for the equation of state at tracer points integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k @@ -759,25 +761,43 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm endif if (CS%use_stanley_pgf) then - do j=js,je ; do i=is,ie ; - p_stanley_scalar=0.0 - do k=1, nz - p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at mid-point of layer - call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, 0.0, 0.0, 0.0, & - rho_stanley_scalar, tv%eqn_of_state) - rho_pgf(i,j,k) = rho_stanley_scalar - call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, tv%varT(i,j,k), 0.0, 0.0, & - rho_stanley_scalar, tv%eqn_of_state) - rho_stanley_pgf(i,j,k) = rho_stanley_scalar - p_stanley(i,j,k) = p_stanley_scalar - p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at bottom of layer - enddo; enddo; enddo - endif + ! Calculated diagnostics related to the Stanley parameterization + zeros(:) = 0.0 + EOSdom_h(:) = EOS_domain(G%HI) + if ((CS%id_p_stanley>0) .or. (CS%id_rho_pgf>0) .or. (CS%id_rho_stanley_pgf>0)) then + ! Find the pressure at the mid-point of each layer. + H_to_RL2_T2 = GV%g_Earth*GV%H_to_RZ + if (use_p_atm) then + do j=js,je ; do i=is,ie + p_stanley(i,j,1) = 0.5*h(i,j,1) * H_to_RL2_T2 + p_atm(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + p_stanley(i,j,1) = 0.5*h(i,j,1) * H_to_RL2_T2 + enddo ; enddo + endif + do k=2,nz ; do j=js,je ; do i=is,ie + p_stanley(i,j,k) = p_stanley(i,j,k-1) + 0.5*(h(i,j,k-1) + h(i,j,k)) * H_to_RL2_T2 + enddo ; enddo ; enddo + endif + if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag) + if (CS%id_rho_pgf>0) then + do k=1,nz ; do j=js,je + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_stanley(:,j,k), zeros, & + zeros, zeros, rho_pgf(:,j,k), tv%eqn_of_state, EOSdom_h) + enddo ; enddo + call post_data(CS%id_rho_pgf, rho_pgf, CS%diag) + endif + if (CS%id_rho_stanley_pgf>0) then + do k=1,nz ; do j=js,je + call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p_stanley(:,j,k), tv%varT(:,j,k), & + zeros, zeros, rho_stanley_pgf(:,j,k), tv%eqn_of_state, EOSdom_h) + enddo ; enddo + call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag) + endif + endif if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag) - if (CS%id_rho_pgf>0) call post_data(CS%id_rho_pgf, rho_pgf, CS%diag) - if (CS%id_rho_stanley_pgf>0) call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag) - if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag) end subroutine PressureForce_FV_Bouss @@ -791,10 +811,14 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(PressureForce_FV_CS), intent(inout) :: CS !< Finite volume PGF control structure type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure + + ! Local variables + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl ! This module's name. - logical :: use_ALE + logical :: use_ALE ! If true, use the Vertical Lagrangian Remap algorithm CS%initialized = .true. CS%diag => diag ; CS%Time => Time @@ -842,12 +866,18 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS "If true, turn on Stanley SGS T variance parameterization "// & "in PGF code.", default=.false.) if (CS%use_stanley_pgf) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_PGF is true.") + CS%id_rho_pgf = register_diag_field('ocean_model', 'rho_pgf', diag%axesTL, & - Time, 'rho in PGF', 'kg m3') + Time, 'rho in PGF', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rho_stanley_pgf = register_diag_field('ocean_model', 'rho_stanley_pgf', diag%axesTL, & - Time, 'rho in PGF with Stanley correction', 'kg m3') + Time, 'rho in PGF with Stanley correction', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_p_stanley = register_diag_field('ocean_model', 'p_stanley', diag%axesTL, & - Time, 'p in PGF with Stanley correction', 'Pa') + Time, 'p in PGF with Stanley correction', 'Pa', conversion=US%RL2_T2_to_Pa) endif if (CS%tides) then CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, & @@ -857,7 +887,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS CS%GFS_scale = 1.0 if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth - call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) + call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale, units="nondim") end subroutine PressureForce_FV_init diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 1ae4a8709a..424e9b1a32 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -874,7 +874,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, US, param_file, diag, CS, tides_ CS%GFS_scale = 1.0 if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth - call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) + call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale, units="nondim") end subroutine PressureForce_Mont_init diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 0949d203ae..bb77a99c4c 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -4432,7 +4432,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "If NONLINEAR_BT_CONTINUITY is true, this is the number "//& "of barotropic time steps between updates to the face "//& "areas, or 0 to update only before the barotropic stepping.", & - units="nondim", default=1, do_not_log=.not.CS%Nonlinear_continuity) + default=1, do_not_log=.not.CS%Nonlinear_continuity) call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& "If true, step the barotropic velocity first and project "//& @@ -4614,6 +4614,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "gravity waves) to 1 (for a backward Euler treatment). "//& "In practice, BEBT must be greater than about 0.05.", & units="nondim", default=0.1) + ! Note that dtbt_input is not rescaled because it has different units for + ! positive [s] and negative [nondim] values. call get_param(param_file, mdl, "DTBT", dtbt_input, & "The barotropic time step, in s. DTBT is only used with "//& "the split explicit time stepping. To set the time step "//& @@ -4621,8 +4623,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "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.", units="s or nondim",& - default = -0.98) + "integer fraction of DT, rounding down.", & + units="s or nondim", default=-0.98) call get_param(param_file, mdl, "BT_USE_OLD_CORIOLIS_BRACKET_BUG", & CS%use_old_coriolis_bracket_bug , & "If True, use an order of operations that is not bitwise "//& @@ -4802,8 +4804,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif if ((dtbt_tmp > 0.0) .and. (dtbt_input > 0.0)) calc_dtbt = .false. - call log_param(param_file, mdl, "DTBT as used", CS%dtbt*US%T_to_s) - call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max*US%T_to_s) + call log_param(param_file, mdl, "DTBT as used", CS%dtbt, units="s", unscale=US%T_to_s) + call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max, units="s", unscale=US%T_to_s) ! ubtav and vbtav, and perhaps ubt_IC and vbt_IC, are allocated and ! initialized in register_barotropic_restarts. diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 11973f8c02..5a098cdf84 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -59,12 +59,14 @@ 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, 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. +subroutine call_OBC_register(G, GV, US, param_file, CS, OBC, tr_Reg) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file to parse + type(update_OBC_CS), pointer :: CS !< Control structure for OBCs + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. ! Local variables character(len=200) :: config @@ -124,7 +126,7 @@ subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg) register_Kelvin_OBC(param_file, CS%Kelvin_OBC_CSp, US, & OBC%OBC_Reg) if (CS%use_shelfwave) CS%use_shelfwave = & - register_shelfwave_OBC(param_file, CS%shelfwave_OBC_CSp, US, & + register_shelfwave_OBC(param_file, CS%shelfwave_OBC_CSp, G, US, & OBC%OBC_Reg) if (CS%use_dyed_channel) CS%use_dyed_channel = & register_dyed_channel_OBC(param_file, CS%dyed_channel_OBC_CSp, US, & diff --git a/src/core/MOM_check_scaling.F90 b/src/core/MOM_check_scaling.F90 index 55bd471fee..1d7c27b6fd 100644 --- a/src/core/MOM_check_scaling.F90 +++ b/src/core/MOM_check_scaling.F90 @@ -28,19 +28,23 @@ subroutine check_MOM6_scaling_factors(GV, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - integer, parameter :: ndims = 6 ! The number of rescalable dimensional factors. + integer, parameter :: ndims = 8 ! The number of rescalable dimensional factors. real, dimension(ndims) :: scales ! An array of scaling factors for each of the basic units. integer, dimension(ndims) :: scale_pow2 ! The powers of 2 that give each element of scales. character(len=2), dimension(ndims) :: key - ! character(len=128) :: mesg, msg_frag integer, allocatable :: weights(:) character(len=80), allocatable :: descriptions(:) - ! logical :: verbose, very_verbose integer :: n, ns, max_pow + ! If no scaling is being done, simply return. + if ((US%Z_to_m == 1.) .and. (GV%H_to_MKS == 1.) .and. (US%L_to_m == 1.) .and. & + (US%T_to_s == 1.) .and. (US%R_to_kg_m3 == 1.) .and. (US%Q_to_J_kg == 1.) .and. & + (US%C_to_degC == 1.) .and. (US%S_to_ppt == 1.)) return + ! Set the names and scaling factors of the dimensions being rescaled. - key(:) = ["Z", "H", "L", "T", "R", "Q"] - scales(:) = (/ US%Z_to_m, GV%H_to_MKS, US%L_to_m, US%T_to_s, US%R_to_kg_m3, US%Q_to_J_kg /) + key(:) = ["Z", "H", "L", "T", "R", "Q", "C", "S"] + scales(:) = (/ US%Z_to_m, GV%H_to_MKS, US%L_to_m, US%T_to_s, US%R_to_kg_m3, US%Q_to_J_kg, & + US%C_to_degC, US%S_to_ppt/) call scales_to_powers(scales, scale_pow2) max_pow = 40 ! 60 @@ -71,124 +75,134 @@ subroutine compose_dimension_list(ns, des, wts) !! perhaps the number of times it occurs in the MOM6 code. ns = 0 - ! Accumulate a list of units used in MOM6, in approximate descending order of frequency of occurrence. - call add_scaling(ns, des, wts, "[H ~> m or kg m-2]", 1239) ! Layer thicknesses - call add_scaling(ns, des, wts, "[Z ~> m]", 660) ! Depths and vertical distance - call add_scaling(ns, des, wts, "[L T-1 ~> m s-1]", 506) ! Horizontal velocities - call add_scaling(ns, des, wts, "[R ~> kg m-3]", 356) ! Densities - call add_scaling(ns, des, wts, "[T-1 ~> s-1]", 247) ! Rates - call add_scaling(ns, des, wts, "[T ~> s]", 237) ! Time intervals - call add_scaling(ns, des, wts, "[R L2 T-2 ~> Pa]", 231) ! Dynamic pressure + ! Accumulate a list of units used in MOM6, in approximate descending order of frequency of occurrence in + ! doxygen comments (i.e., arguments and elements in types), excluding the code in the user, ice_shelf and + ! framework directories and the passive tracer packages. + call add_scaling(ns, des, wts, "[H ~> m or kg m-2]", 716) ! Layer thicknesses + call add_scaling(ns, des, wts, "[L T-1 ~> m s-1]", 264) ! Horizontal velocities + call add_scaling(ns, des, wts, "[Z ~> m]", 244) ! Depths and vertical distance + call add_scaling(ns, des, wts, "[T ~> s]", 154) ! Time intervals + call add_scaling(ns, des, wts, "[S ~> ppt]", 135) ! Salinities + call add_scaling(ns, des, wts, "[C ~> degC]", 135) ! Temperatures + call add_scaling(ns, des, wts, "[R L2 T-2 ~> Pa]", 133) ! Dynamic pressure ! call add_scaling(ns, des, wts, "[R L2 T-2 ~> J m-3]") ! Energy density - call add_scaling(ns, des, wts, "[Z2 T-1 ~> m2 s-1]", 181) ! Vertical viscosities and diffusivities - call add_scaling(ns, des, wts, "[H L2 ~> m3 or kg]", 174) ! Cell volumes or masses - call add_scaling(ns, des, wts, "[H L2 T-1 ~> m3 s-1 or kg s-1]", 163) ! Volume or mass transports - call add_scaling(ns, des, wts, "[L T-2 ~> m s-2]", 136) ! Horizontal accelerations - call add_scaling(ns, des, wts, "[L ~> m]", 107) ! Horizontal distances - call add_scaling(ns, des, wts, "[Z T-1 ~> m s-1]", 104) ! Friction velocities and viscous coupling - call add_scaling(ns, des, wts, "[H-1 ~> m-1 or m2 kg-1]", 89) ! Inverse cell thicknesses - call add_scaling(ns, des, wts, "[L2 T-2 ~> m2 s-2]", 88) ! Resolved kinetic energy per unit mass - call add_scaling(ns, des, wts, "[R Z3 T-2 ~> J m-2]", 85) ! Integrated turbulent kinetic energy density - call add_scaling(ns, des, wts, "[L2 T-1 ~> m2 s-1]", 78) ! Horizontal viscosity or diffusivity - call add_scaling(ns, des, wts, "[T-2 ~> s-2]", 69) ! Squared shears and buoyancy frequency - call add_scaling(ns, des, wts, "[H L ~> m2 or kg m-1]", 68) ! Lateral cell face areas - call add_scaling(ns, des, wts, "[L2 ~> m2]", 67) ! Horizontal areas - - call add_scaling(ns, des, wts, "[R-1 ~> m3 kg-1]", 61) ! Specific volumes - call add_scaling(ns, des, wts, "[Q R Z T-1 ~> W m-2]", 62) ! Vertical heat fluxes - call add_scaling(ns, des, wts, "[Z-1 ~> m-1]", 60) ! Inverse vertical distances - call add_scaling(ns, des, wts, "[L2 Z-1 T-2 ~> m s-2]", 57) ! Gravitational acceleration - call add_scaling(ns, des, wts, "[R Z T-1 ~> kg m-2 s-1]", 52) ! Vertical mass fluxes - call add_scaling(ns, des, wts, "[H T-1 ~> m s-1 or kg m-2 s-1]", 51) ! Vertical thickness fluxes - call add_scaling(ns, des, wts, "[R Z3 T-3 ~> W m-2]", 45) ! Integrated turbulent kinetic energy sources - call add_scaling(ns, des, wts, "[R Z ~> kg m-2]", 42) ! Layer or column mass loads - call add_scaling(ns, des, wts, "[Z3 T-3 ~> m3 s-3]", 33) ! Integrated turbulent kinetic energy sources - call add_scaling(ns, des, wts, "[H2 ~> m2 or kg2 m-4]", 35) ! Squared layer thicknesses - call add_scaling(ns, des, wts, "[Z2 T-2 ~> m2 s-2]", 33) ! Turbulent kinetic energy - call add_scaling(ns, des, wts, "[L-1 ~> m-1]", 32) ! Inverse horizontal distances - call add_scaling(ns, des, wts, "[R L Z T-2 ~> Pa]", 27) ! Wind stresses - call add_scaling(ns, des, wts, "[T2 L-2 ~> s2 m-2]", 33) ! Inverse velocities squared - call add_scaling(ns, des, wts, "[R Z L2 T-2 ~> J m-2]", 25) ! Integrated energy - ! call add_scaling(ns, des, wts, "[R L2 Z T-2 ~> Pa m]") ! Depth integral of pressures (25) - call add_scaling(ns, des, wts, "[Z L2 T-2 ~> m3 s-2]", 25) ! Integrated energy - call add_scaling(ns, des, wts, "[H R ~> kg m-2 or kg2 m-5]", 24) ! Layer-integrated density - call add_scaling(ns, des, wts, "[L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]", 20) ! pbce or gtot - call add_scaling(ns, des, wts, "[L-1 T-1 ~> m-1 s-1]", 19) ! Laplacian of velocity - - call add_scaling(ns, des, wts, "[L4 T-1 ~> m4 s-1]", 18) ! Biharmonic viscosity - call add_scaling(ns, des, wts, "[Z L T-1 ~> m2 s-1]", 17) ! Layer integrated velocities - call add_scaling(ns, des, wts, "[Z L-1 ~> nondim]", 15) ! Slopes - call add_scaling(ns, des, wts, "[Z L2 ~> m3]", 14) ! Diagnostic volumes - call add_scaling(ns, des, wts, "[H L T-1 ~> m2 s-1 or kg m-1 s-1]", 12) ! Layer integrated velocities - call add_scaling(ns, des, wts, "[L2 T-3 ~> m2 s-3]", 14) ! Buoyancy flux or MEKE sources [L2 T-3 ~> W kg-1] - call add_scaling(ns, des, wts, "[Z2 ~> m2]", 12) ! Squared vertical distances - call add_scaling(ns, des, wts, "[R Z L2 T-1 ~> kg s-1]", 12) ! Mass fluxes - call add_scaling(ns, des, wts, "[L-2 ~> m-2]", 12) ! Inverse areas - call add_scaling(ns, des, wts, "[L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]", 11) ! Gravitational acceleration over density - call add_scaling(ns, des, wts, "[Z T-2 ~> m s-2]", 10) ! Buoyancy differences or their derivatives - ! Could also add [Z T-2 degC-1 ~> m s-2 degC-1] or [Z T-2 ppt-1 ~> m s-2 ppt-1] - call add_scaling(ns, des, wts, "[R Z L2 T-3 ~> W m-2]", 10) ! Energy sources, including for MEKE - call add_scaling(ns, des, wts, "[L3 ~> m3]", 10) ! Metric dependent constants for viscosity - call add_scaling(ns, des, wts, "[Z-2 ~> m-2]", 9) ! Inverse of denominator in some weighted averages - call add_scaling(ns, des, wts, "[H-2 ~> m-2 or m4 kg-2]", 9) ! Mixed layer local work variables - call add_scaling(ns, des, wts, "[Z L2 T-1 ~> m3 s-1]", 9) ! Overturning (GM) streamfunction - call add_scaling(ns, des, wts, "[L2 Z-2 T-2 ~> s-2]", 9) ! Buoyancy frequency in some params. - call add_scaling(ns, des, wts, "[Q R Z ~> J m-2]", 8) ! time-integrated frazil heat flux + call add_scaling(ns, des, wts, "[Z2 T-1 ~> m2 s-1]", 132) ! Vertical viscosities and diffusivities + call add_scaling(ns, des, wts, "[R ~> kg m-3]", 122) ! Densities + + call add_scaling(ns, des, wts, "[H L2 T-1 ~> m3 s-1 or kg s-1]", 97) ! Volume or mass transports + call add_scaling(ns, des, wts, "[H L2 ~> m3 or kg]", 91) ! Cell volumes or masses + call add_scaling(ns, des, wts, "[L T-2 ~> m s-2]", 82) ! Horizontal accelerations + call add_scaling(ns, des, wts, "[T-1 ~> s-1]", 67) ! Rates + call add_scaling(ns, des, wts, "[Z T-1 ~> m s-1]", 56) ! Friction velocities and viscous coupling + call add_scaling(ns, des, wts, "[Q R Z T-1 ~> W m-2]", 42) ! Vertical heat fluxes + call add_scaling(ns, des, wts, "[L2 T-1 ~> m2 s-1]", 45) ! Horizontal viscosity or diffusivity + call add_scaling(ns, des, wts, "[L2 T-2 ~> m2 s-2]", 37) ! Resolved kinetic energy per unit mass + call add_scaling(ns, des, wts, "[L ~> m]", 35) ! Horizontal distances + call add_scaling(ns, des, wts, "[T-2 ~> s-2]", 33) ! Squared shears and buoyancy frequency + + call add_scaling(ns, des, wts, "[R Z L T-2 ~> Pa]", 33) ! Wind stresses + call add_scaling(ns, des, wts, "[H L ~> m2 or kg m-1]", 32) ! Lateral cell face areas + call add_scaling(ns, des, wts, "[L2 ~> m2]", 31) ! Horizontal areas + call add_scaling(ns, des, wts, "[R C-1 ~> kg m-3 degC-1]", 26) ! Thermal expansion coefficients + call add_scaling(ns, des, wts, "[L2 Z-1 T-2 ~> m s-2]", 26) ! Gravitational acceleration + call add_scaling(ns, des, wts, "[R S-1 ~> kg m-3 ppt-1]", 23) ! Haline contraction coefficients + call add_scaling(ns, des, wts, "[R Z3 T-3 ~> W m-2]", 23) ! Integrated turbulent kinetic energy sources + call add_scaling(ns, des, wts, "[R Z T-1 ~> kg m-2 s-1]", 19) ! Vertical mass fluxes + call add_scaling(ns, des, wts, "[C H ~> degC m or degC kg m-2]", 17) ! Heat content + call add_scaling(ns, des, wts, "[H-1 ~> m-1 or m2 kg-1]", 17) ! Inverse cell thicknesses + + call add_scaling(ns, des, wts, "[Z-1 ~> m-1]", 14) ! Inverse vertical distances + call add_scaling(ns, des, wts, "[R-1 ~> m3 kg-1]", 14) ! Specific volumes + call add_scaling(ns, des, wts, "[Z L-1 ~> nondim]", 12) ! Slopes + call add_scaling(ns, des, wts, "[L-1 ~> m-1]", 12) ! Inverse horizontal distances + call add_scaling(ns, des, wts, "[L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]", 12) ! pbce or gtot + call add_scaling(ns, des, wts, "[R Z ~> kg m-2]", 11) ! Layer or column mass loads + call add_scaling(ns, des, wts, "[Z L2 T-2 ~> m3 s-2]", 11) ! Integrated energy per unit mass + call add_scaling(ns, des, wts, "[R Z3 T-2 ~> J m-2]", 11) ! Integrated turbulent kinetic energy density + call add_scaling(ns, des, wts, "[H T-1 ~> m s-1 or kg m-2 s-1]", 9) ! Vertical thickness fluxes + call add_scaling(ns, des, wts, "[L-1 T-1 ~> m-1 s-1]", 9) ! Laplacian of velocity + + call add_scaling(ns, des, wts, "[Z3 T-3 ~> m3 s-3]", 9) ! Integrated turbulent kinetic energy sources + call add_scaling(ns, des, wts, "[S H ~> ppt m or ppt kg m-2]", 8) ! Depth integrated salinity + call add_scaling(ns, des, wts, "[Z2 T-2 ~> m2 s-2]", 8) ! Turbulent kinetic energy + call add_scaling(ns, des, wts, "[R L2 Z T-2 ~> Pa m]", 7) ! Vertically integrated pressure anomalies call add_scaling(ns, des, wts, "[Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]", 7) ! (TKE_to_Kd) - call add_scaling(ns, des, wts, "[Q degC-1 ~> J kg-1 degC-1]", 7) ! Heat capacity - - call add_scaling(ns, des, wts, "[R Z2 T-2 ~> J m-3]", 6) ! Potential energy height derivatives - call add_scaling(ns, des, wts, "[R Z3 T-2 H-1 ~> J m-3 or J kg-1]", 7) ! Partial derivatives of energy - call add_scaling(ns, des, wts, "[R L2 T-2 Z-1 ~> Pa m-1]", 7) ! Converts depth to pressure - call add_scaling(ns, des, wts, "[L4 Z-1 T-1 ~> m3 s-1]", 7) ! Rigidity of ice - call add_scaling(ns, des, wts, "[H L2 T-3 ~> m3 s-3]", 9) ! Kinetic energy diagnostics - call add_scaling(ns, des, wts, "[H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]", 6) ! Layer potential vorticity - call add_scaling(ns, des, wts, "[R Z2 T-3 ~> W m-3]", 3) ! Kinetic energy dissipation rates - call add_scaling(ns, des, wts, "[Z2 L-2 ~> 1]", 1) ! Slopes squared - call add_scaling(ns, des, wts, "[Z H-1 ~> nondim or m3 kg-1]", 6) ! Thickness to height conversion - call add_scaling(ns, des, wts, "[Pa T2 R-1 L-2 ~> 1]", 6) ! Pressure conversion factor - ! Could also add [m T2 R-1 L-2 ~> m Pa-1] - ! Could also add [degC T2 R-1 L-2 ~> degC Pa-1] - call add_scaling(ns, des, wts, "[R H-1 ~> kg m-4 or m-1]", 5) ! Vertical density gradients + call add_scaling(ns, des, wts, "[L4 T-1 ~> m4 s-1]", 7) ! Biharmonic viscosity + call add_scaling(ns, des, wts, "[L3 ~> m3]", 7) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[L2 T-3 ~> m2 s-3]", 7) ! Buoyancy flux or MEKE sources [L2 T-3 ~> W kg-1] + call add_scaling(ns, des, wts, "[H2 ~> m2 or kg2 m-4]", 7) ! Squared layer thicknesses + call add_scaling(ns, des, wts, "[C H T-1 ~> degC m s-1 or degC kg m-2 s-1]", 7) ! vertical heat fluxes + + call add_scaling(ns, des, wts, "[L-2 ~> m-2]", 6) ! Inverse areas + call add_scaling(ns, des, wts, "[R Z L2 T-3 ~> W m-2]", 6) ! Energy sources, including for MEKE + call add_scaling(ns, des, wts, "[Z2 T-3 ~> m2 s-3]", 5) ! Certain buoyancy fluxes + call add_scaling(ns, des, wts, "[Z2 ~> m2]", 5) ! Squared vertical distances + call add_scaling(ns, des, wts, "[S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]", 5) ! vertical salinity fluxes + call add_scaling(ns, des, wts, "[R-1 C-1 ~> m3 kg-1 degC-1]", 5) ! Specific volume temperature gradient + call add_scaling(ns, des, wts, "[R-1 S-1 ~> m3 kg-1 ppt-1]", 4) ! Specific volume salnity gradient + call add_scaling(ns, des, wts, "[Q R Z ~> J m-2]", 4) ! time-integrated frazil heat flux + call add_scaling(ns, des, wts, "[Z C-1 ~> m degC-1]", 4) ! Inverse temperature gradients + call add_scaling(ns, des, wts, "[Z S-1 ~> m ppt-1]", 4) ! Inverse salinity gradients + + call add_scaling(ns, des, wts, "[R Z3 T-2 H-1 ~> J m-3 or J kg-1]", 4) ! Partial derivatives of energy + call add_scaling(ns, des, wts, "[R Z3 T-2 S-1 ~> J m-2 ppt-1]", 4) ! Sensitity of energy change to salinity + call add_scaling(ns, des, wts, "[R Z3 T-2 C-1 ~> J m-2 degC-1]", 4) ! Sensitity of energy change to temperature call add_scaling(ns, des, wts, "[R L4 T-4 ~> Pa m2 s-2]", 4) ! Integral in geopotential of pressure - call add_scaling(ns, des, wts, "[L Z-1 ~> nondim]", 4) ! Inverse slopes + call add_scaling(ns, des, wts, "[Q ~> J kg-1]", 4) ! Latent heats + call add_scaling(ns, des, wts, "[Q C-1 ~> J kg-1 degC-1]", 4) ! Heat capacity call add_scaling(ns, des, wts, "[L-3 ~> m-3]", 4) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[L2 Z-2 T-2 ~> s-2]", 4) ! Buoyancy frequency in some params. + call add_scaling(ns, des, wts, "[H R ~> kg m-2 or kg2 m-5]", 4) ! Layer-integrated density + call add_scaling(ns, des, wts, "[H L T-1 ~> m2 s-1 or kg m-1 s-1]", 4) ! Layer integrated velocities + call add_scaling(ns, des, wts, "[H T2 L-1 ~> s2 or kg s2 m-3]", 4) ! BT_cont_type face curvature fit call add_scaling(ns, des, wts, "[H L-1 ~> nondim or kg m-3]", 4) ! BT_cont_type face curvature fit - call add_scaling(ns, des, wts, "[kg H-1 L-2 ~> kg m-3 or 1]", 20) ! Diagnostic conversions to mass - ! Could also add [m3 H-1 L-2 ~> 1 or m3 kg-1] - call add_scaling(ns, des, wts, "[Z T-2 R-1 ~> m4 s-2 kg-1]", 9) ! Gravitational acceleration over density - call add_scaling(ns, des, wts, "[R Z L4 T-3 ~> kg m2 s-3]", 9) ! MEKE fluxes - call add_scaling(ns, des, wts, "[R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]", 3) ! Thickness to pressure conversion - - call add_scaling(ns, des, wts, "[R-1 Z-1 ~> m2 kg-1]", 3) ! Inverse of column mass - call add_scaling(ns, des, wts, "[L4 ~> m4]", 3) ! Metric dependent constants for viscosity - call add_scaling(ns, des, wts, "[T-1 Z-1 ~> s-1 m-1]", 2) ! Barotropic PV, for some options - call add_scaling(ns, des, wts, "[R Z2 T-1 ~> J s m-3]", 2) ! River mixing term [R Z2 T-1 ~> Pa s] - call add_scaling(ns, des, wts, "[degC Q-1 ~> kg degC J-1]", 2) ! Inverse heat capacity - ! Could add call add_scaling(ns, des, wts, "[Q-1 ~> kg J-1]", 1) ! Inverse heat content - call add_scaling(ns, des, wts, "[L4 Z-2 T-1 ~> m2 s-1]", 2) ! Ice rigidity term - call add_scaling(ns, des, wts, "[R Z-1 ~> kg m-4]", 3) ! Vertical density gradient - call add_scaling(ns, des, wts, "[R Z L2 ~> kg]", 3) ! Depth and time integrated mass fluxes - call add_scaling(ns, des, wts, "[R L2 T-3 ~> W m-2]", 3) ! Depth integrated friction work - call add_scaling(ns, des, wts, "[ppt2 R-2 ~> ppt2 m6 kg-2]", 3) ! T / S gauge transformation - call add_scaling(ns, des, wts, "[R L-1 ~> kg m-4]", 2) ! Horizontal density gradient - ! Could add call add_scaling(ns, des, wts, "[H Z ~> m2 or kg m-1]", 2) ! Temporary variables - call add_scaling(ns, des, wts, "[Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]", 2) ! Heating to PE change - call add_scaling(ns, des, wts, "[R2 L2 Z2 T-4 ~> Pa2]", 2) ! Squared wind stresses - call add_scaling(ns, des, wts, "[L-2 T-2 ~> m-2 s-2]", 2) ! Squared Laplacian of velocity - call add_scaling(ns, des, wts, "[T H Z-1 ~> s or s kg m-3]", 2) ! Time step times thickness conversion - call add_scaling(ns, des, wts, "[T H Z-1 R-1 ~> s m3 kg-1 or s]", 2) ! Time step over density with conversion - call add_scaling(ns, des, wts, "[H-3 ~> m-3 or m6 kg-3]", 1) ! A local term in ePBL - call add_scaling(ns, des, wts, "[H-4 ~> m-4 or m8 kg-4]", 1) ! A local term in ePBL - call add_scaling(ns, des, wts, "[H T Z-2 ~> s m-1 or kg s m-4]", 1) ! A local term in ePBL - - call add_scaling(ns, des, wts, "[H3 ~> m3 or kg3 m-6]", 1) ! Thickness cubed in a denominator - call add_scaling(ns, des, wts, "[H2 T-2 ~> m2 s-2 or kg2 m-4 s-2]", 1) ! Thickness times f squared - call add_scaling(ns, des, wts, "[H T2 R-1 Z-2 ~> m Pa-1 or s2 m-1]", 1) ! Pressure to thickness conversion - call add_scaling(ns, des, wts, "[L2 Z-2 ~> nondim]", 1) ! Inverse slope squared - call add_scaling(ns, des, wts, "[H R L2 T-2 ~> m Pa]", 1) ! Integral in thickness of pressure - call add_scaling(ns, des, wts, "[R T2 Z-1 ~> kg s2 m-4]", 1) ! Density divided by gravitational acceleration + call add_scaling(ns, des, wts, "[C2 ~> degC2]", 4) ! Squared temperature anomalies + call add_scaling(ns, des, wts, "[S2 ~> ppt2]", 3) ! Squared salinity anomalies + call add_scaling(ns, des, wts, "[C S ~> degC ppt]", 3) ! Covariance of temperature and salinity anomalies + call add_scaling(ns, des, wts, "[S R Z ~> gSalt m-2]", 3) ! Total ocean column salt + call add_scaling(ns, des, wts, "[C R Z ~> degC kg m-2]", 3) ! Total ocean column temperature + call add_scaling(ns, des, wts, "[Pa T2 R-1 L-2 ~> 1]", 3) ! Pressure conversions + call add_scaling(ns, des, wts, "[Z H-1 ~> nondim or m3 kg-1]", 3) ! Thickness to height conversion + call add_scaling(ns, des, wts, "[R Z2 T-2 ~> J m-3]", 3) ! Potential energy height derivatives + + call add_scaling(ns, des, wts, "[H-2 ~> m-2 or m4 kg-2]", 3) ! Mixed layer local work variables + call add_scaling(ns, des, wts, "[C S-1 ~> degC ppt-1]", 2) ! T / S gauge transformation + call add_scaling(ns, des, wts, "[R S-2 ~> kg m-3 ppt-2]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[R C-2 ~> kg m-3 degC-2]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[R S-1 C-1 ~> kg m-3 ppt-1 degC-1]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[T2 S-1 L-2 ~> kg m-3 ppt-1 Pa-1]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[T2 C-1 L-2 ~> kg m-3 degC-1 Pa-1]", 2) ! Second derivative of density + call add_scaling(ns, des, wts, "[T2 L-2 ~> s2 m-2]", 2) ! Inverse velocities squared + call add_scaling(ns, des, wts, "[R Z2 T-3 ~> W m-3]", 2) ! Kinetic energy dissipation rates + call add_scaling(ns, des, wts, "[R H-1 ~> kg m-4 or m-1]", 2) ! Vertical density gradients + + call add_scaling(ns, des, wts, "[L4 ~> m4]", 2) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[Z L T-1 ~> m2 s-1]", 2) ! Layer integrated velocities + call add_scaling(ns, des, wts, "[C Z ~> degC m]", 2) ! Depth integrated temperature + call add_scaling(ns, des, wts, "[S Z ~> ppt m]", 1) ! Layer integrated salinity + call add_scaling(ns, des, wts, "[T L4 ~> s m4]", 2) ! Biharmonic metric dependent constant + call add_scaling(ns, des, wts, "[L6 ~> m6]", 2) ! Biharmonic Leith metric dependent constant + call add_scaling(ns, des, wts, "[L4 Z-1 T-1 ~> m3 s-1]", 2) ! Rigidity of ice + call add_scaling(ns, des, wts, "[L4 Z-2 T-1 ~> m2 s-1]", 1) ! Ice rigidity term + call add_scaling(ns, des, wts, "[R-1 Z-1 ~> m2 kg-1]", 1) ! Inverse of column mass + call add_scaling(ns, des, wts, "[Z-2 ~> m-2]", 1) ! Inverse of denominator in some weighted averages + + call add_scaling(ns, des, wts, "[R Z2 T-1 ~> J s m-3]", 1) ! River mixing term + call add_scaling(ns, des, wts, "[R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]", 1) ! Thickness to pressure conversion + call add_scaling(ns, des, wts, "[Z T2 R-1 L-2 ~> m Pa-1]", 1) ! Atmospheric pressure SSH correction + call add_scaling(ns, des, wts, "[T Z ~> s m] ", 1) ! Time integrated SSH + call add_scaling(ns, des, wts, "[Z-1 T-1 ~> m-1 s-1]", 1) ! barotropic PV + call add_scaling(ns, des, wts, "[L2 T ~> m2 s]", 1) ! Greatbatch & Lamb 90 coefficient + call add_scaling(ns, des, wts, "[Z L2 T-1 ~> m3 s-1]", 1) ! Overturning (GM) streamfunction + call add_scaling(ns, des, wts, "[kg H-1 L-2 ~> kg m-3 or 1]", 1) ! Diagnostic conversions to mass + call add_scaling(ns, des, wts, "[S-1 ~> ppt-1]", 1) ! Unscaling salinity + call add_scaling(ns, des, wts, "[C-1 ~> degC-1]", 1) ! Unscaling temperature + + call add_scaling(ns, des, wts, "[R Z H-1 ~> kg m-3 or 1] ", 1) ! A unit conversion factor + call add_scaling(ns, des, wts, "[H R-1 Z-1 ~> m3 kg-2 or 1]", 1) ! A unit conversion factor + call add_scaling(ns, des, wts, "[H Z-1 ~> 1 or kg m-3]", 1) ! A unit conversion factor + call add_scaling(ns, des, wts, "[m T s-1 L-1 ~> 1]", 1) ! A unit conversion factor end subroutine compose_dimension_list diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index aa080e1e8e..bc908ee60c 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -29,9 +29,9 @@ module MOM_checksum_packages !> A type for storing statistica about a variable type :: stats ; private - real :: minimum = 1.E34 !< The minimum value - real :: maximum = -1.E34 !< The maximum value - real :: average = 0. !< The average value + real :: minimum = 1.E34 !< The minimum value [degC] or [ppt] or other units + real :: maximum = -1.E34 !< The maximum value [degC] or [ppt] or other units + real :: average = 0. !< The average value [degC] or [ppt] or other units end type stats contains @@ -39,7 +39,7 @@ module MOM_checksum_packages ! ============================================================================= !> Write out chksums for the model's basic state variables, including transports. -subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, vel_scale) +subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, symmetric, omit_corners, vel_scale) character(len=*), & intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -60,6 +60,7 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully symmetric !! computational domain. + logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: vel_scale !< The scaling factor to convert velocities to [m s-1] real :: scale_vel ! The scaling factor to convert velocities to [m s-1] @@ -73,16 +74,17 @@ subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, US, haloshift, sy sym = .false. ; if (present(symmetric)) sym=symmetric scale_vel = US%L_T_to_m_s ; if (present(vel_scale)) scale_vel = vel_scale - call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, scale=scale_vel) - call hchksum(h, mesg//" h", G%HI, haloshift=hs, scale=GV%H_to_m) - call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, & - symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) + call uvchksum(mesg//" [uv]", u, v, G%HI, haloshift=hs, symmetric=sym, & + omit_corners=omit_corners, scale=scale_vel) + call hchksum(h, mesg//" h", G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_m) + call uvchksum(mesg//" [uv]h", uh, vh, G%HI, haloshift=hs, symmetric=sym, & + omit_corners=omit_corners, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) end subroutine MOM_state_chksum_5arg ! ============================================================================= !> Write out chksums for the model's basic state variables. -subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) +subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric, omit_corners) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -92,11 +94,12 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is !! used to rescale u and v if present. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. + logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts integer :: hs logical :: sym @@ -106,30 +109,43 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) ! and js...je as their extent. hs = 1 ; if (present(haloshift)) hs = haloshift sym = .false. ; if (present(symmetric)) sym = symmetric - call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, & + omit_corners=omit_corners, scale=US%L_T_to_m_s) + call hchksum(h, mesg//" h",G%HI, haloshift=hs, omit_corners=omit_corners, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg ! ============================================================================= !> Write out chksums for the model's thermodynamic state variables. -subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift) +subroutine MOM_thermo_chksum(mesg, tv, G, US, haloshift, omit_corners) character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). + logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts integer :: hs hs=1 ; if (present(haloshift)) hs=haloshift - if (associated(tv%T)) call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs, scale=US%C_to_degC) - if (associated(tv%S)) call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs, scale=US%S_to_ppt) - if (associated(tv%frazil)) call hchksum(tv%frazil, mesg//" frazil", G%HI, haloshift=hs, & - scale=US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m) - if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, & - scale=US%S_to_ppt*US%RZ_to_kg_m2) + if (associated(tv%T)) & + call hchksum(tv%T, mesg//" T", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%C_to_degC) + if (associated(tv%S)) & + call hchksum(tv%S, mesg//" S", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%S_to_ppt) + if (associated(tv%frazil)) & + call hchksum(tv%frazil, mesg//" frazil", G%HI, haloshift=hs, omit_corners=omit_corners, & + scale=US%Q_to_J_kg*US%R_to_kg_m3*US%Z_to_m) + if (associated(tv%salt_deficit)) & + call hchksum(tv%salt_deficit, mesg//" salt deficit", G%HI, haloshift=hs, omit_corners=omit_corners, & + scale=US%S_to_ppt*US%RZ_to_kg_m2) + if (associated(tv%varT)) & + call hchksum(tv%varT, mesg//" varT", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%C_to_degC**2) + if (associated(tv%varS)) & + call hchksum(tv%varS, mesg//" varS", G%HI, haloshift=hs, omit_corners=omit_corners, scale=US%S_to_ppt**2) + if (associated(tv%covarTS)) & + call hchksum(tv%covarTS, mesg//" covarTS", G%HI, haloshift=hs, omit_corners=omit_corners, & + scale=US%S_to_ppt*US%C_to_degC) end subroutine MOM_thermo_chksum diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 54eecd20c3..090d1ee0fb 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1044,7 +1044,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_in !< Layer thickness used to !! calculate fluxes [H ~> m or kg m-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vh !< Volume flux through meridional - !! faces = v*h*dx [H L2 s-1 ~> m3 s-1 or kg s-1] + !! faces = v*h*dx [H L2 T-1 ~> m3 s-1 or kg s-1] real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure.G diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90 index 1e51612e6d..e1fb3d3278 100644 --- a/src/core/MOM_density_integrals.F90 +++ b/src/core/MOM_density_integrals.F90 @@ -143,7 +143,7 @@ subroutine int_density_dz_generic_pcm(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real :: p5(5) ! Pressures at five quadrature points [R L2 T-2 ~> Pa] real :: r5(5) ! Densities at five quadrature points [R ~> kg m-3] real :: rho_anom ! The depth averaged density anomaly [R ~> kg m-3] - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] real :: GxRho ! The product of the gravitational acceleration and reference density [R L2 Z-1 T-2 ~> Pa m-1] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: dz ! The layer thickness [Z ~> m] @@ -784,7 +784,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, & real :: w_left, w_right ! Left and right weights [nondim] real :: intz(5) ! The gravitational acceleration times the integrals of density ! with height at the 5 sub-column locations [R L2 T-2 ~> Pa] - real, parameter :: C1_90 = 1.0/90.0 ! Rational constants. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] real :: GxRho ! The gravitational acceleration times density [R L2 Z-1 T-2 ~> kg m-2 s-2] real :: I_Rho ! The inverse of the Boussinesq density [R-1 ~> m3 kg-1] real :: dz ! Layer thicknesses at tracer points [Z ~> m] @@ -1175,7 +1175,7 @@ subroutine int_spec_vol_dp_generic_pcm(T, S, p_t, p_b, alpha_ref, HI, EOS, US, d real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2] logical :: do_massWeight ! Indicates whether to do mass weighting. - real, parameter :: C1_90 = 1.0/90.0 ! A rational constant. + real, parameter :: C1_90 = 1.0/90.0 ! A rational constant [nondim] integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, n, halo Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB @@ -1550,10 +1550,10 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t !! are anomalous to [R ~> kg m-3] real, intent(in) :: G_e !< Gravitational acceleration [L2 Z-1 T-2 ~> m s-2] type(EOS_type), intent(in) :: EOS !< Equation of state 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 real, intent(out) :: P_b !< Pressure at the bottom of the cell [R L2 T-2 ~> Pa] real, intent(out) :: z_out !< Absolute depth at which anomalous pressure = p_tgt [Z ~> m] - real, optional, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m] + real, intent(in) :: z_tol !< The tolerance in finding z_out [Z ~> m] ! Local variables real :: dp ! Pressure thickness of the layer [R L2 T-2 ~> Pa] @@ -1583,8 +1583,7 @@ subroutine find_depth_of_pressure_in_cell(T_t, T_b, S_t, S_b, z_t, z_b, P_t, P_t Pa_left = P_t - P_tgt ! Pa_left < 0 F_r = 1. Pa_right = P_b - P_tgt ! Pa_right > 0 - Pa_tol = GxRho * 1.0e-5*US%m_to_Z - if (present(z_tol)) Pa_tol = GxRho * z_tol + Pa_tol = GxRho * z_tol F_guess = F_l - Pa_left / (Pa_right - Pa_left) * (F_r - F_l) Pa = Pa_right - Pa_left ! To get into iterative loop diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 68f8c97669..74ab4e1f18 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -36,7 +36,7 @@ module MOM_dynamics_split_RK2 use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) -use MOM_ALE, only : ALE_CS +use MOM_ALE, only : ALE_CS, ALE_remap_velocities use MOM_barotropic, only : barotropic_init, btstep, btcalc, bt_mass_source use MOM_barotropic, only : register_barotropic_restarts, set_dtbt, barotropic_CS use MOM_barotropic, only : barotropic_end @@ -160,6 +160,9 @@ module MOM_dynamics_split_RK2 !! predictor step. This is used to accomodate various generations !! of restart files. logical :: use_tides !< If true, tidal forcing is enabled. + logical :: remap_aux !< If true, apply ALE remapping to all of the auxiliary 3-D + !! variables that are needed to reproduce across restarts, + !! similarly to what is done with the primary state variables. real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme [nondim] @@ -256,6 +259,7 @@ module MOM_dynamics_split_RK2 public step_MOM_dyn_split_RK2 public register_restarts_dyn_split_RK2 public initialize_dyn_split_RK2 +public remap_dyn_split_RK2_aux_vars public end_dyn_split_RK2 !>@{ CPU time clock IDs @@ -402,8 +406,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) - call check_redundant("Start predictor u ", u, v, G) - call check_redundant("Start predictor uh ", uh, vh, G) + call check_redundant("Start predictor u ", u, v, G, unscale=US%L_T_to_m_s) + call check_redundant("Start predictor uh ", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) endif dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) @@ -539,10 +543,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call MOM_accel_chksum("pre-btstep accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) - call check_redundant("pre-btstep CS%CA ", CS%CAu_pred, CS%CAv_pred, G) - call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) - call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + call check_redundant("pre-btstep CS%CA ", CS%CAu_pred, CS%CAv_pred, G, unscale=US%L_T2_to_m_s2) + call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G, unscale=US%L_T2_to_m_s2) endif call cpu_clock_begin(id_clock_vertvisc) @@ -563,7 +567,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug) then call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif - call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) if (showCallTree) call callTree_wayPoint("done with vertvisc_coef (step_MOM_dyn_split_RK2)") @@ -643,10 +647,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) call MOM_accel_chksum("Predictor accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) - call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & + call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=1, & symmetric=sym) - call check_redundant("Predictor 1 up", up, vp, G) - call check_redundant("Predictor 1 uh", uh, vh, G) + call check_redundant("Predictor 1 up", up, vp, G, unscale=US%L_T_to_m_s) + call check_redundant("Predictor 1 uh", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) endif ! up <- up + dt_pred d/dz visc d/dz up @@ -656,7 +660,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call uvchksum("0 before vertvisc: [uv]p", up, vp, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) endif call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & - CS%OBC) + CS%OBC, VarMix) call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%AD_pred, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") @@ -774,8 +778,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call uvchksum("Predictor avg [uv]", u_av, v_av, G%HI, haloshift=1, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h_av, "Predictor avg h", G%HI, haloshift=0, scale=GV%H_to_m) ! call MOM_state_chksum("Predictor avg ", u_av, v_av, h_av, uh, vh, G, GV, US) - call check_redundant("Predictor up ", up, vp, G) - call check_redundant("Predictor uh ", uh, vh, G) + call check_redundant("Predictor up ", up, vp, G, unscale=US%L_T_to_m_s) + call check_redundant("Predictor uh ", uh, vh, G, unscale=GV%H_to_m*US%L_to_m**2*US%s_to_T) endif ! diffu = horizontal viscosity terms (u_av) @@ -816,10 +820,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) - call check_redundant("corr pre-btstep CS%CA ", CS%CAu, CS%CAv, G) - call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) - call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) - call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) + call check_redundant("corr pre-btstep CS%CA ", CS%CAu, CS%CAv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G, unscale=US%L_T2_to_m_s2) + call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G, unscale=US%L_T2_to_m_s2) endif ! u_accel_bt = layer accelerations due to barotropic solver @@ -844,7 +848,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (showCallTree) call callTree_leave("btstep()") if (CS%debug) then - call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G) + call check_redundant("u_accel_bt ", CS%u_accel_bt, CS%v_accel_bt, G, unscale=US%L_T2_to_m_s2) endif ! u = u + dt*( u_bc_accel + u_accel_bt ) @@ -863,8 +867,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call cpu_clock_end(id_clock_mom_update) if (CS%debug) then - call uvchksum("Corrector 1 [uv]", u, v, G%HI,haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) - call hchksum(h, "Corrector 1 h", G%HI, haloshift=2, scale=GV%H_to_m) + call uvchksum("Corrector 1 [uv]", u, v, G%HI, haloshift=0, symmetric=sym, scale=US%L_T_to_m_s) + call hchksum(h, "Corrector 1 h", G%HI, haloshift=1, scale=GV%H_to_m) call uvchksum("Corrector 1 [uv]h", uh, vh, G%HI, haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) ! call MOM_state_chksum("Corrector 1", u, v, h, uh, vh, G, GV, US, haloshift=1) @@ -876,7 +880,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s ! u <- u + dt d/dz visc d/dz u ! u_av <- u_av + dt d/dz visc d/dz u_av call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, G, GV, US, & CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot,waves=waves) if (G%nonblocking_updates) then @@ -1160,6 +1164,32 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, US, param_file, CS, restart_C end subroutine register_restarts_dyn_split_RK2 +!> This subroutine does remapping for the auxiliary restart variables that are used +!! with the split RK2 time stepping scheme. +subroutine remap_dyn_split_RK2_aux_vars(G, GV, CS, h_old, h_new, ALE_CSp, OBC, dzRegrid) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2] + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure to use when remapping + type(ocean_OBC_type), pointer :: OBC !< OBC control structure to use when remapping + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(in) :: dzRegrid !< Change in interface position [H ~> m or kg m-2] + + if (.not.CS%remap_aux) return + + if (CS%store_CAu) then + call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%u_av, CS%v_av, OBC, dzRegrid) + call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%CAu_pred, CS%CAv_pred, OBC, dzRegrid) + endif + + call ALE_remap_velocities(ALE_CSp, G, GV, h_old, h_new, CS%diffu, CS%diffv, OBC, dzRegrid) + +end subroutine remap_dyn_split_RK2_aux_vars + !> This subroutine initializes all of the variables that are used by this !! dynamic core, including diagnostics and the cpu clocks. subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param_file, & @@ -1276,6 +1306,13 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param "If true, calculate the Coriolis accelerations at the end of each "//& "timestep for use in the predictor step of the next split RK2 timestep.", & default=.true.) + call get_param(param_file, mdl, "REMAP_AUXILIARY_VARS", CS%remap_aux, & + "If true, apply ALE remapping to all of the auxiliary 3-dimensional "//& + "variables that are needed to reproduce across restarts, similarly to "//& + "what is already being done with the primary state variables. "//& + "The default should be changed to true.", default=.false., do_not_log=.true.) + if (CS%remap_aux .and. .not.CS%store_CAu) call MOM_error(FATAL, & + "REMAP_AUXILIARY_VARS requires that STORE_CORIOLIS_ACCEL = True.") call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) @@ -1508,10 +1545,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective U-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive=.true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective V-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive=.true.) if (GV%Boussinesq) then CS%id_deta_dt = register_diag_field('ocean_model', 'deta_dt', diag%axesT1, Time, & diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index bc20c30a0f..e6f99cc9d8 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -345,7 +345,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) dt_visc = 0.5*dt ; if (CS%use_correct_dt_visc) dt_visc = dt_pred - call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, visc, dt_visc, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_visc, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -405,7 +405,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! upp <- upp + dt/2 d/dz visc d/dz upp call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(upp, vpp, hp, forces, visc, dt*0.5, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(upp, vpp, hp, forces, visc, dt*0.5, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -489,7 +489,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & ! u <- u + dt d/dz visc d/dz u call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u, v, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u, v, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, Waves=Waves) call cpu_clock_end(id_clock_vertvisc) @@ -692,10 +692,10 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective U Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive=.true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective V Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive=.true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 957306eb3d..fbf416d13d 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -341,7 +341,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call set_viscous_ML(u_in, v_in, h_av, tv, forces, visc, dt_visc, G, GV, US, CS%set_visc_CSp) call disable_averaging(CS%diag) - call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) @@ -392,10 +392,10 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! up[n] <- up* + dt d/dz visc d/dz up ! u[n] <- u*[n] + dt d/dz visc d/dz u[n] call cpu_clock_begin(id_clock_vertvisc) - call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(up, vp, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(up, vp, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp, & G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) - call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC) + call vertvisc_coef(u_in, v_in, h_av, forces, visc, dt, G, GV, US, CS%vertvisc_CSp, CS%OBC, VarMix) call vertvisc(u_in, v_in, h_av, forces, visc, dt, CS%OBC, CS%ADp, CS%CDp,& G, GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot) call cpu_clock_end(id_clock_vertvisc) @@ -655,10 +655,10 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag CS%id_PFv = register_diag_field('ocean_model', 'PFv', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration', 'meter second-2', conversion=US%L_T2_to_m_s2) CS%id_ueffA = register_diag_field('ocean_model', 'ueffA', diag%axesCuL, Time, & - 'Effective U-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective U-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & y_cell_method='sum', v_extensive=.true.) CS%id_veffA = register_diag_field('ocean_model', 'veffA', diag%axesCvL, Time, & - 'Effective V-Face Area', 'm^2', conversion = GV%H_to_m*US%L_to_m, & + 'Effective V-Face Area', 'm^2', conversion=GV%H_to_m*US%L_to_m, & x_cell_method='sum', v_extensive=.true.) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e7fc638e15..a3b7d604dd 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -10,7 +10,7 @@ module MOM_forcing_type use MOM_debugging, only : hchksum, uvchksum use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled -use MOM_diag_mediator, only : enable_averages, enable_averaging, disable_averaging +use MOM_diag_mediator, only : enable_averages, disable_averaging use MOM_EOS, only : calculate_density_derivs, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -253,7 +253,7 @@ module MOM_forcing_type rigidity_ice_v => NULL() !< Depth-integrated lateral viscosity of ice shelves or sea ice at !! v-points [L4 Z-1 T-1 ~> m3 s-1] real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes - !! have been averaged [s]. + !! have been averaged [T ~> s]. logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided. logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere !! and various types of ice needs to be accumulated, and the @@ -965,7 +965,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! [H T-1 ~> m s-1 or kg m-2 s-1] real, dimension(SZI_(G)) :: netHeat ! net temp flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(max(nsw,1), SZI_(G)) :: penSWbnd ! penetrating SW radiation by band - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R C-1 ~> kg m-3 degC-1] real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R S-1 ~> kg m-3 ppt-1] @@ -992,7 +992,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] - ! netHeat = heat via surface fluxes [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! netHeat = heat via surface fluxes [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] ! netSalt = salt via surface fluxes [S H T-1 ~> ppt m s-1 or gSalt m-2 s-1] ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux ! this call returns the rate because dt=1 (in arbitrary time units) @@ -1011,12 +1011,12 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt tv%eqn_of_state, EOS_domain(G%HI)) ! Adjust netSalt to reflect dilution effect of FW flux - ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] + ! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) ! Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. - ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] + ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 ) netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) @@ -2285,7 +2285,7 @@ end subroutine copy_back_forcing_fields !! fields registered as part of register_forcing_type_diags. subroutine mech_forcing_diags(forces_in, dt, G, time_end, diag, handles) type(mech_forcing), target, intent(in) :: forces_in !< mechanical forcing input fields - real, intent(in) :: dt !< time step for the forcing [s] + real, intent(in) :: dt !< time step for the forcing [T ~> s] type(ocean_grid_type), intent(in) :: G !< grid type type(time_type), intent(in) :: time_end !< The end time of the diagnostic interval. type(diag_ctrl), intent(inout) :: diag !< diagnostic type @@ -2310,7 +2310,7 @@ subroutine mech_forcing_diags(forces_in, dt, G, time_end, diag, handles) endif is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - call enable_averaging(dt, time_end, diag) + call enable_averages(dt, time_end, diag) ! if (query_averaging_enabled(diag)) then if ((handles%id_taux > 0) .and. associated(forces%taux)) & diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index f3a48f3ded..2e413e505b 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -75,8 +75,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & mask2dT, & !< 0 for land points and 1 for ocean points on the h-grid [nondim]. - geoLatT, & !< The geographic latitude at q points in degrees of latitude or m. - geoLonT, & !< The geographic longitude at q points in degrees of longitude or m. + geoLatT, & !< The geographic latitude at q points [degrees_N] or [km] or [m]. + geoLonT, & !< The geographic longitude at q points [degrees_E] or [km] or [m]. dxT, & !< dxT is delta x at h points [L ~> m]. IdxT, & !< 1/dxT [L-1 ~> m-1]. dyT, & !< dyT is delta y at h points [L ~> m]. @@ -84,15 +84,15 @@ module MOM_grid areaT, & !< The area of an h-cell [L2 ~> m2]. IareaT, & !< 1/areaT [L-2 ~> m-2]. sin_rot, & !< The sine of the angular rotation between the local model grid's northward - !! and the true northward directions. + !! and the true northward directions [nondim]. cos_rot !< The cosine of the angular rotation between the local model grid's northward - !! and the true northward directions. + !! and the true northward directions [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. OBCmaskCu, & !< 0 for boundary or OBC points and 1 for ocean points on the u grid [nondim]. - geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. - geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. + geoLatCu, & !< The geographic latitude at u points [degrees_N] or [km] or [m] + geoLonCu, & !< The geographic longitude at u points [degrees_E] or [km] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. IdxCu, & !< 1/dxCu [L-1 ~> m-1]. dyCu, & !< dyCu is delta y at u points [L ~> m]. @@ -104,8 +104,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. OBCmaskCv, & !< 0 for boundary or OBC points and 1 for ocean points on the v grid [nondim]. - geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. - geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. + geoLatCv, & !< The geographic latitude at v points [degrees_N] or [km] or [m] + geoLonCv, & !< The geographic longitude at v points [degrees_E] or [km] or [m]. dxCv, & !< dxCv is delta x at v points [L ~> m]. IdxCv, & !< 1/dxCv [L-1 ~> m-1]. dyCv, & !< dyCv is delta y at v points [L ~> m]. @@ -126,8 +126,8 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & mask2dBu, & !< 0 for boundary points and 1 for ocean points on the q grid [nondim]. - geoLatBu, & !< The geographic latitude at q points in degrees of latitude or m. - geoLonBu, & !< The geographic longitude at q points in degrees of longitude or m. + geoLatBu, & !< The geographic latitude at q points [degrees_N] or [km] or [m] + geoLonBu, & !< The geographic longitude at q points [degrees_E] or [km] or [m]. dxBu, & !< dxBu is delta x at q points [L ~> m]. IdxBu, & !< 1/dxBu [L-1 ~> m-1]. dyBu, & !< dyBu is delta y at q points [L ~> m]. @@ -146,8 +146,12 @@ module MOM_grid gridLonB => NULL() !< The longitude of B points for the purpose of labeling the output axes. !! On many grids this is the same as geoLonBu. character(len=40) :: & + ! Except on a Cartesian grid, these are usually some variant of "degrees". x_axis_units, & !< The units that are used in labeling the x coordinate axes. - y_axis_units !< The units that are used in labeling the y coordinate axes. + y_axis_units, & !< The units that are used in labeling the y coordinate axes. + ! These are internally generated names, including "m", "km", "deg_E" and "deg_N". + x_ax_unit_short, & !< A short description of the x-axis units for documenting parameter units + y_ax_unit_short !< A short description of the y-axis units for documenting parameter units real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. @@ -181,8 +185,8 @@ module MOM_grid ! These parameters are run-time parameters that are used during some ! initialization routines (but not all) - real :: south_lat !< The latitude (or y-coordinate) of the first v-line - real :: west_lon !< The longitude (or x-coordinate) of the first u-line + real :: south_lat !< The latitude (or y-coordinate) of the first v-line [degrees_N] or [km] or [m] + real :: west_lon !< The longitude (or x-coordinate) of the first u-line [degrees_E] or [km] or [m] real :: len_lat !< The latitudinal (or y-coord) extent of physical domain real :: len_lon !< The longitudinal (or x-coord) extent of physical domain real :: Rad_Earth !< The radius of the planet [m] @@ -221,9 +225,11 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v integer, allocatable, dimension(:) :: ibegin, iend, jbegin, jend character(len=40) :: mod_nm = "MOM_grid" ! This module's name. + mean_SeaLev_scale = 1.0 ; if (associated(G%US)) mean_SeaLev_scale = G%US%m_to_Z ! Read all relevant parameters and write them to the model log. - call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, default=0.0, do_not_log=.true.) + call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, & + units="m", default=0.0, scale=mean_SeaLev_scale, do_not_log=.true.) call log_version(param_file, mod_nm, version, & "Parameters providing information about the lateral grid.", & log_to_all=.true., layout=.true., all_default=(G%Z_ref==0.0)) @@ -236,7 +242,6 @@ subroutine MOM_grid_init(G, param_file, US, HI, global_indexing, bathymetry_at_v layoutParam=.true.) if (present(US)) then ; if (associated(US)) G%US => US ; endif - mean_SeaLev_scale = 1.0 ; if (associated(G%US)) mean_SeaLev_scale = G%US%m_to_Z call get_param(param_file, mod_nm, "REFERENCE_HEIGHT", G%Z_ref, & "A reference value for geometric height fields, such as bathyT.", & units="m", default=0.0, scale=mean_SeaLev_scale) @@ -477,8 +482,8 @@ end subroutine set_derived_metrics !> Adcroft_reciprocal(x) = 1/x for |x|>0 or 0 for x=0. function Adcroft_reciprocal(val) result(I_val) - real, intent(in) :: val !< The value being inverted. - real :: I_val !< The Adcroft reciprocal of val. + real, intent(in) :: val !< The value being inverted [A]. + real :: I_val !< The Adcroft reciprocal of val [A-1]. I_val = 0.0 ; if (val /= 0.0) I_val = 1.0/val end function Adcroft_reciprocal @@ -488,12 +493,12 @@ logical function isPointInCell(G, i, j, x, y) type(ocean_grid_type), intent(in) :: G !< Grid type integer, intent(in) :: i !< i index of cell to test integer, intent(in) :: j !< j index of cell to test - real, intent(in) :: x !< x coordinate of point - real, intent(in) :: y !< y coordinate of point + real, intent(in) :: x !< x coordinate of point [degrees_E] + real, intent(in) :: y !< y coordinate of point [degrees_N] ! Local variables - real :: xNE, xNW, xSE, xSW ! Longitudes of cell corners [degLon] - real :: yNE, yNW, ySE, ySW ! Latitudes of cell corners [degLat] - real :: l0, l1, l2, l3 ! Crossed products of differences in position [degLon degLat] + real :: xNE, xNW, xSE, xSW ! Longitudes of cell corners [degrees_E] + real :: yNE, yNW, ySE, ySW ! Latitudes of cell corners [degrees_N] + real :: l0, l1, l2, l3 ! Crossed products of differences in position [degrees_E degrees_N] real :: p0, p1, p2, p3 ! Trinary unitary values reflecting the signs of the crossed products [nondim] isPointInCell = .false. xNE = G%geoLonBu(i ,j ) ; yNE = G%geoLatBu(i ,j ) diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index b5bd51d75a..07dd19b0a6 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -3,12 +3,12 @@ module MOM_isopycnal_slopes ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density_derivs -use MOM_EOS, only : calculate_density_second_derivs +use MOM_debugging, only : hchksum, uvchksum +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density_derivs, calculate_density_second_derivs, EOS_domain use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S @@ -28,13 +28,12 @@ module MOM_isopycnal_slopes !> Calculate isopycnal slopes, and optionally return other stratification dependent functions such as N^2 !! and dz*S^2*g-prime used, or calculable from factors used, during the calculation. subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stanley, & - slope_x, slope_y, N2_u, N2_v, dzu, dzv, dzSxN, dzSyN, halo, OBC) !, eta_to_m) + slope_x, slope_y, N2_u, N2_v, dzu, dzv, dzSxN, dzSyN, halo, OBC) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m] or units - !! given by 1/eta_to_m) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity @@ -61,15 +60,12 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan integer, optional, intent(in) :: halo !< Halo width over which to compute type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. - ! real, optional, intent(in) :: eta_to_m !< The conversion factor from the units - ! (This argument has been tested but for now serves no purpose.) !! of eta to m; US%Z_to_m by default. ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & T, & ! The temperature [C ~> degC], with the values in ! in massless layers filled vertically by diffusion. - S !, & ! The filled salinity [S ~> ppt], with the values in + S ! The filled salinity [S ~> ppt], with the values in ! in massless layers filled vertically by diffusion. -! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3]. real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & pres ! The pressure at an interface [R L2 T-2 ~> Pa]. real, dimension(SZI_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored. @@ -96,15 +92,17 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan T_hr, & ! Temperature on the interface at the h (+1) point [C ~> degC]. S_hr, & ! Salinity on the interface at the h (+1) point [S ~> ppt] pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. - real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density - real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the - ! interface times the grid spacing [R ~> kg m-3]. + real :: drdiA, drdiB ! Along layer zonal potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. + real :: drdjA, drdjB ! Along layer meridional potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. real :: hg2A, hg2B ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. real :: dzaL, dzaR ! Temporary thicknesses in eta units [Z ~> m]. - real :: wtA, wtB, wtL, wtR ! Unscaled weights, with various units. + real :: wtA, wtB ! Unnormalized weights of the slopes above and below [H3 ~> m3 or kg3 m-6] + real :: wtL, wtR ! Unnormalized weights of the slopes to the left and right [H3 Z ~> m4 or kg3 m-5] real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. real :: slope ! The slope of density surfaces, calculated in a way @@ -117,33 +115,34 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! in roundoff and can be neglected [Z ~> m]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real :: G_Rho0 ! The gravitational acceleration divided by density [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] - real :: Z_to_L ! A conversion factor between from units for e to the - ! units for lateral distances [L Z-1 ~> 1] - real :: L_to_Z ! A conversion factor between from units for lateral distances - ! to the units for e [Z L-1 ~> 1] - real :: H_to_Z ! A conversion factor from thickness units to the units of e [Z H-1 ~> 1 or m3 kg-1] logical :: present_N2_u, present_N2_v - integer, dimension(2) :: EOSdom_u, EOSdom_v ! Domains for the equation of state calculations at u and v points + logical :: local_open_u_BC, local_open_v_BC ! True if u- or v-face OBCs exist anywhere in the global domain. + integer, dimension(2) :: EOSdom_u ! The shifted I-computational domain to use for equation of + ! state calculations at u-points. + integer, dimension(2) :: EOSdom_v ! The shifted i-computational domain to use for equation of + ! state calculations at v-points. + integer, dimension(2) :: EOSdom_h1 ! The shifted i-computational domain to use for equation of + ! state calculations at h points with 1 extra halo point integer :: is, ie, js, je, nz, IsdB integer :: i, j, k integer :: l_seg - logical :: local_open_u_BC, local_open_v_BC if (present(halo)) then is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + EOSdom_h1(:) = EOS_domain(G%HI, halo=halo+1) else is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + EOSdom_h1(:) = EOS_domain(G%HI, halo=1) endif + EOSdom_u(1) = is-1 - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) + EOSdom_v(:) = EOS_domain(G%HI, halo=halo) + nz = GV%ke ; IsdB = G%IsdB + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - Z_to_L = US%Z_to_L ; H_to_Z = GV%H_to_Z - ! if (present(eta_to_m)) then - ! Z_to_L = eta_to_m*US%m_to_L ; H_to_Z = GV%H_to_m / eta_to_m - ! endif - L_to_Z = 1.0 / Z_to_L - dz_neglect = GV%H_subroundoff * H_to_Z + dz_neglect = GV%H_subroundoff * GV%H_to_Z local_open_u_BC = .false. local_open_v_BC = .false. @@ -221,12 +220,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan enddo ; enddo enddo - EOSdom_u(1) = is-1 - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) - !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv,h,e, & - !$OMP h_neglect,dz_neglect,Z_to_L,L_to_Z,H_to_Z,h_neglect2, & - !$OMP present_N2_u,G_Rho0,N2_u,slope_x,dzSxN,EOSdom_u,local_open_u_BC, & - !$OMP dzu,OBC,use_stanley) & + !$OMP h_neglect,dz_neglect,h_neglect2, & + !$OMP present_N2_u,G_Rho0,N2_u,slope_x,dzSxN,EOSdom_u,EOSdom_h1, & + !$OMP local_open_u_BC,dzu,OBC,use_stanley) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & @@ -259,7 +256,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is-1,ie-is+3]) + tv%eqn_of_state, dom=EOSdom_h1) endif do I=is-1,ie @@ -294,7 +291,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect @@ -318,7 +315,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = (Z_to_L*drdx)**2 + drdz**2 + mag_grad2 = (US%Z_to_L*drdx)**2 + drdz**2 if (mag_grad2 > 0.0) then slope = drdx / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -351,11 +348,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan enddo ! I enddo ; enddo ! end of j-loop - EOSdom_v(1) = is - (G%isd-1) ; EOSdom_v(2) = ie - (G%isd-1) - ! Calculate the meridional isopycnal slope. !$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, & - !$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, & + !$OMP h,h_neglect,e,dz_neglect, & !$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,dzSyN,EOSdom_v, & !$OMP dzv,local_open_v_BC,OBC,use_stanley) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, & @@ -393,10 +388,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, dom=EOSdom_v) call calculate_density_second_derivs(T_hr, S_hr, pres_hr, & scrap, scrap, drho_dT_dT_hr, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, dom=EOSdom_v) endif do i=is,ie if (use_EOS) then @@ -430,7 +425,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect if (GV%Boussinesq) then - dzaL = haL * H_to_Z ; dzaR = haR * H_to_Z + dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z else dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect @@ -454,7 +449,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan ! This estimate of slope is accurate for small slopes, but bounded ! to be between -1 and 1. - mag_grad2 = (Z_to_L*drdy)**2 + drdz**2 + mag_grad2 = (US%Z_to_L*drdy)**2 + drdz**2 if (mag_grad2 > 0.0) then slope = drdy / sqrt(mag_grad2) else ! Just in case mag_grad2 = 0 ever. @@ -513,8 +508,9 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar ! Local variables real :: ent(SZI_(G),SZK_(GV)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep [H ~> m or kg m-2]. - real :: b1(SZI_(G)), d1(SZI_(G)) ! b1, c1, and d1 are variables used by the - real :: c1(SZI_(G),SZK_(GV)) ! tridiagonal solver. + real :: b1(SZI_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1] + real :: d1(SZI_(G)) ! A variable used by the tridiagonal solver [nondim], d1 = 1 - c1. + real :: c1(SZI_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: kap_dt_x2 ! The 2*kappa_dt converted to H units [H2 ~> m2 or kg2 m-4]. real :: h_neglect ! A negligible thickness [H ~> m or kg m-2], to allow for zero thicknesses. real :: h0 ! A negligible thickness to allow for zero thickness layers without @@ -541,7 +537,7 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar T_f(i,j,k) = T_in(i,j,k) ; S_f(i,j,k) = S_in(i,j,k) enddo ; enddo ; enddo else - !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) + !$OMP parallel do default(shared) private(ent,b1,d1,c1,h_tr) do j=js,je do i=is,ie ent(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1cc8505d17..9bd292e796 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -57,10 +57,15 @@ module MOM_open_boundary public segment_tracer_registry_end public register_segment_tracer public register_temp_salt_segments +public register_obgc_segments public fill_temp_salt_segments +public fill_obgc_segments +public set_obgc_segments_props +public setup_OBC_tracer_reservoirs public open_boundary_register_restarts public update_segment_tracer_reservoirs public update_OBC_ramp +public remap_OBC_fields public rotate_OBC_config public rotate_OBC_init public initialize_segment_data @@ -78,7 +83,8 @@ module MOM_open_boundary type, public :: OBC_segment_data_type integer :: fid !< handle from FMS associated with segment data on disk integer :: fid_dz !< handle from FMS associated with segment thicknesses on disk - character(len=8) :: name !< a name identifier for the segment data + character(len=32) :: name !< a name identifier for the segment data + character(len=8) :: genre !< an identifier for the segment data real :: scale !< A scaling factor for converting input data to !! the internal units of this field real, allocatable :: buffer_src(:,:,:) !< buffer for segment data located at cell faces @@ -91,6 +97,10 @@ module MOM_open_boundary !! The values for tracers should have the same units as the field !! they are being applied to? real :: value !< constant value if fid is equal to -1 + real :: resrv_lfac_in = 1. !< reservoir inverse length scale factor for IN direction per field + !< the general 1/Lscale_IN is multiplied by this factor for each tracer + real :: resrv_lfac_out= 1. !< reservoir inverse length scale factor for OUT direction per field + !< the general 1/Lscale_OUT is multiplied by this factor for each tracer end type OBC_segment_data_type !> Tracer on OBC segment data structure, for putting into a segment tracer registry. @@ -262,6 +272,8 @@ module MOM_open_boundary logical :: user_BCs_set_globally = .false. !< True if any OBC_USER_CONFIG is set !! for input from user directory. logical :: update_OBC = .false. !< Is OBC data time-dependent + logical :: update_OBC_seg_data = .false. !< Is it the time for OBC segment data update for fields that + !! require less frequent update logical :: needs_IO_for_data = .false. !< Is any i/o needed for OBCs logical :: zero_vorticity = .false. !< If True, sets relative vorticity to zero on open boundaries. logical :: freeslip_vorticity = .false. !< If True, sets normal gradient of tangential velocity to zero @@ -304,6 +316,9 @@ module MOM_open_boundary ! Which segment object describes the current point. integer, allocatable :: segnum_u(:,:) !< Segment number of u-points. integer, allocatable :: segnum_v(:,:) !< Segment number of v-points. + ! Keep the OBC segment properties for external BGC tracers + type(external_tracers_segments_props), pointer :: obgc_segments_props => NULL() !< obgc segment properties + integer :: num_obgc_tracers = 0 !< The total number of obgc tracers ! The following parameters are used in the baroclinic radiation code: real :: gamma_uv !< The relative weighting for the baroclinic radiation @@ -370,6 +385,15 @@ module MOM_open_boundary !! When locked=.true.,no more boundaries can be registered. end type OBC_registry_type +!> Type to carry OBC information needed for setting segments for OBGC tracers +type, private :: external_tracers_segments_props + type(external_tracers_segments_props), pointer :: next => NULL() !< pointer to the next node + character(len=128) :: tracer_name !< tracer name + character(len=128) :: tracer_src_file !< tracer source file for BC + character(len=128) :: tracer_src_field !< name of the field in source file to extract BC + real :: lfac_in !< multiplicative factor for inbound tracer reservoir length scale + real :: lfac_out !< multiplicative factor for outbound tracer reservoir length scale +end type external_tracers_segments_props integer :: id_clock_pass !< A CPU time clock character(len=40) :: mdl = "MOM_open_boundary" !< This module's name. @@ -704,7 +728,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) type(ocean_OBC_type), target, intent(inout) :: OBC !< Open boundary control structure type(param_file_type), intent(in) :: PF !< Parameter file handle - integer :: n, m, num_fields + integer :: n, m, num_fields, mm character(len=1024) :: segstr character(len=256) :: filename character(len=20) :: segnam, suffix @@ -721,6 +745,7 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) integer, dimension(:), allocatable :: saved_pelist integer :: current_pe integer, dimension(1) :: single_pelist + type(external_tracers_segments_props), pointer :: obgc_segments_props_list =>NULL() !will be able to dynamically switch between sub-sampling refined grid data or model grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -772,8 +797,9 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) cycle ! cycle to next segment endif - allocate(segment%field(num_fields)) - segment%num_fields = num_fields + !There are OBC%num_obgc_tracers obgc tracers are there that are not listed in param file + segment%num_fields = num_fields + OBC%num_obgc_tracers + allocate(segment%field(segment%num_fields)) segment%temp_segment_data_exists = .false. segment%salt_segment_data_exists = .false. @@ -786,9 +812,28 @@ subroutine initialize_segment_data(G, GV, US, OBC, PF) IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB - do m=1,num_fields - call parse_segment_data_str(trim(segstr), m, trim(fields(m)), & - value, filename, fieldname) + obgc_segments_props_list => OBC%obgc_segments_props !pointer to the head node + do m=1,segment%num_fields + if (m .le. num_fields) then + !These are tracers with segments specified in MOM6 style override files + call parse_segment_data_str(trim(segstr), m, trim(fields(m)), value, filename, fieldname) + else + !These are obgc tracers with segments specified by external modules. + !Set a flag so that these can be distinguished from native tracers as they may need + !extra steps for preparation and handling. + segment%field(m)%genre = 'obgc' + !Query the obgc segment properties by traversing the linkedlist + call get_obgc_segments_props(obgc_segments_props_list,fields(m),filename,fieldname,& + segment%field(m)%resrv_lfac_in,segment%field(m)%resrv_lfac_out) + !Make sure the obgc tracer is not specified in the MOM6 param file too. + do mm=1,num_fields + if(trim(fields(m)) == trim(fields(mm))) then + if(is_root_pe()) & + call MOM_error(FATAL,"MOM_open_boundary:initialize_segment_data(): obgc tracer " //trim(fields(m))// & + " appears in OBC_SEGMENT_XXX_DATA string in MOM6 param file. This is not supported!") + endif + enddo + endif if (trim(filename) /= 'none') then OBC%update_OBC = .true. ! Data is assumed to be time-dependent if we are reading from file OBC%needs_IO_for_data = .true. ! At least one segment is using I/O for OBC data @@ -1737,7 +1782,7 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) logical, intent(in) :: use_temperature !< If true, T and S are used ! Local variables - integer :: n,m,num_fields + integer :: n,m,num_fields,na character(len=1024) :: segstr character(len=256) :: filename character(len=20) :: segnam, suffix @@ -1789,6 +1834,23 @@ subroutine parse_for_tracer_reservoirs(OBC, PF, use_temperature) OBC%tracer_y_reservoirs_used(2) = .true. endif endif + !Add reservoirs for external/obgc tracers + !There is a diconnect in the above logic between tracer index and reservoir index. + !It arbitarily assigns reservoir indexes 1&2 to tracers T&S, + !So we need to start from reservoir index for non-native tracers from 3, hence na=2 below. + !num_fields is the number of vars in segstr (6 of them now, U,V,SSH,TEMP,SALT,dye) + !but OBC%tracer_x_reservoirs_used is allocated to size Reg%ntr, which is the total number of tracers + na=2 !number of native MOM6 tracers (T&S) with reservoirs + do m=1,OBC%num_obgc_tracers + !This logic assumes all external tarcers need a reservoir + !The segments for tracers are not initialized yet (that happens later in initialize_segment_data()) + !so we cannot query to determine if this tracer needs a reservoir. + if (segment%is_E_or_W_2) then + OBC%tracer_x_reservoirs_used(m+na) = .true. + else + OBC%tracer_y_reservoirs_used(m+na) = .true. + endif + enddo enddo return @@ -3491,6 +3553,22 @@ function lookup_seg_field(OBC_seg,field) end function lookup_seg_field +!> Return the tracer index from its name +function get_tracer_index(OBC_seg,tr_name) + type(OBC_segment_type), pointer :: OBC_seg !< OBC segment + character(len=*), intent(in) :: tr_name !< The field name + integer :: get_tracer_index, it + get_tracer_index=-1 + it=1 + do while(allocated(OBC_seg%tr_Reg%Tr(it)%t)) + if (trim(OBC_seg%tr_Reg%Tr(it)%name) == trim(tr_name)) then + get_tracer_index=it + exit + endif + it=it+1 + enddo + return +end function get_tracer_index !> Allocate segment data fields subroutine allocate_OBC_segment_data(OBC, segment) @@ -3715,7 +3793,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) type(time_type), intent(in) :: Time !< Model time ! Local variables integer :: c, i, j, k, is, ie, js, je, isd, ied, jsd, jed - integer :: IsdB, IedB, JsdB, JedB, n, m, nz + integer :: IsdB, IedB, JsdB, JedB, n, m, nz, nt type(OBC_segment_type), pointer :: segment => NULL() integer, dimension(4) :: siz real, dimension(:,:,:), pointer :: tmp_buffer_in => NULL() ! Unrotated input [various units] @@ -3810,6 +3888,10 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) allocate(h_stack(GV%ke), source=0.0) do m = 1,segment%num_fields + !This field may not require a high frequency OBC segment update and might be allowed + !a less frequent update as set by the parameter update_OBC_period_max in MOM.F90. + !Cycle if it is not the time to update OBC segment data for this field. + if (trim(segment%field(m)%genre) == 'obgc' .and. (.not. OBC%update_OBC_seg_data)) cycle if (segment%field(m)%fid > 0) then siz(1)=size(segment%field(m)%buffer_src,1) siz(2)=size(segment%field(m)%buffer_src,2) @@ -4173,6 +4255,8 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! Start second loop to update all fields now that data for all fields are available. ! (split because tides depend on multiple variables). do m = 1,segment%num_fields + !cycle if it is not the time to update OBGC tracers from source + if (trim(segment%field(m)%genre) == 'obgc' .and. (.not. OBC%update_OBC_seg_data)) cycle ! if (segment%field(m)%fid>0) then ! calculate external BT velocity and transport if needed if (trim(segment%field(m)%name) == 'U' .or. trim(segment%field(m)%name) == 'V') then @@ -4359,6 +4443,25 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) else segment%tr_Reg%Tr(2)%OBC_inflow_conc = segment%field(m)%value endif + elseif (trim(segment%field(m)%genre) == 'obgc') then + nt=get_tracer_index(segment,trim(segment%field(m)%name)) + if(nt .lt. 0) then + call MOM_error(FATAL,"update_OBC_segment_data: Did not find tracer "//trim(segment%field(m)%name)) + endif + if (allocated(segment%field(m)%buffer_dst)) then + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + segment%tr_Reg%Tr(nt)%t(i,j,k) = segment%field(m)%buffer_dst(i,j,k) + enddo ; enddo ; enddo + if (.not. segment%tr_Reg%Tr(nt)%is_initialized) then + !if the tracer reservoir has not yet been initialized, then set to external value. + do k=1,nz; do j=js_obc2, je_obc; do i=is_obc2,ie_obc + segment%tr_Reg%Tr(nt)%tres(i,j,k) = segment%tr_Reg%Tr(nt)%t(i,j,k) + enddo ; enddo ; enddo + segment%tr_Reg%Tr(nt)%is_initialized=.true. + endif + else + segment%tr_Reg%Tr(nt)%OBC_inflow_conc = segment%field(m)%value + endif endif enddo ! end field loop @@ -4660,6 +4763,123 @@ subroutine register_temp_salt_segments(GV, US, OBC, tr_Reg, param_file) end subroutine register_temp_salt_segments +!> Sets the OBC properties of external obgc tracers, such as their source file and field name +subroutine set_obgc_segments_props(OBC,tr_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + type(ocean_OBC_type),pointer :: OBC !< Open boundary structure + character(len=*), intent(in) :: tr_name !< Tracer name + character(len=*), intent(in) :: obc_src_file_name !< OBC source file name + character(len=*), intent(in) :: obc_src_field_name !< name of the field in the source file + real, intent(in) :: lfac_in !< factors for tracer reservoir length scales + real, intent(in) :: lfac_out !< factors for tracer reservoir length scales + + type(external_tracers_segments_props),pointer :: node_ptr => NULL() !pointer to type that keeps + ! the tracer segment properties + allocate(node_ptr) + node_ptr%tracer_name = trim(tr_name) + node_ptr%tracer_src_file = trim(obc_src_file_name) + node_ptr%tracer_src_field = trim(obc_src_field_name) + node_ptr%lfac_in = lfac_in + node_ptr%lfac_out = lfac_out + ! Reversed Linked List implementation! Make this new node to be the head of the list. + node_ptr%next => OBC%obgc_segments_props + OBC%obgc_segments_props => node_ptr + OBC%num_obgc_tracers = OBC%num_obgc_tracers+1 +end subroutine set_obgc_segments_props + +!> Get the OBC properties of external obgc tracers, such as their source file, field name, +!! reservoir length scale factors +subroutine get_obgc_segments_props(node, tr_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + type(external_tracers_segments_props),pointer :: node !< pointer to tracer segment properties + character(len=*), intent(out) :: tr_name !< Tracer name + character(len=*), intent(out) :: obc_src_file_name !< OBC source file name + character(len=*), intent(out) :: obc_src_field_name !< name of the field in the source file + real, intent(out) :: lfac_in !< multiplicative factor for inbound reservoir length scale + real, intent(out) :: lfac_out !< multiplicative factor for outbound reservoir length scale + tr_name = trim(node%tracer_name) + obc_src_file_name = trim(node%tracer_src_file) + obc_src_field_name = trim(node%tracer_src_field) + lfac_in = node%lfac_in + lfac_out = node%lfac_out + node => node%next +end subroutine get_obgc_segments_props + +subroutine register_obgc_segments(GV, OBC, tr_Reg, param_file, tr_name) + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry + type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values + character(len=*), intent(in) :: tr_name!< Tracer name +! Local variables + integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf + integer :: i, j, k, n + type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + type(tracer_type), pointer :: tr_ptr => NULL() + + if (.not. associated(OBC)) return + + do n=1, OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. segment%on_pe) cycle + call tracer_name_lookup(tr_Reg, tr_ptr, tr_name) + call register_segment_tracer(tr_ptr, param_file, GV, segment, OBC_array=.True.) + enddo + +end subroutine register_obgc_segments + +subroutine fill_obgc_segments(G, GV, OBC, tr_ptr, tr_name) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + real, dimension(:,:,:), pointer :: tr_ptr !< Pointer to tracer field + character(len=*), intent(in) :: tr_name!< Tracer name +! Local variables + integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, n, nz, nt + integer :: i, j, k + type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + real :: I_scale + + if (.not. associated(OBC)) return + call pass_var(tr_ptr, G%Domain) + nz = G%ke + do n=1, OBC%number_of_segments + segment => OBC%segment(n) + if (.not. segment%on_pe) cycle + nt=get_tracer_index(segment,tr_name) + if(nt .lt. 0) then + call MOM_error(FATAL,"fill_obgc_segments: Did not find tracer "// tr_name) + endif + isd = segment%HI%isd ; ied = segment%HI%ied + jsd = segment%HI%jsd ; jed = segment%HI%jed + IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB + JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB + I_scale = 1.0 + if (segment%tr_Reg%Tr(nt)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(nt)%scale + ! Fill with Tracer values + if (segment%is_E_or_W) then + I=segment%HI%IsdB + do k=1,nz ; do j=segment%HI%jsd,segment%HI%jed + if (segment%direction == OBC_DIRECTION_W) then + segment%tr_Reg%Tr(nt)%t(I,j,k) = tr_ptr(i+1,j,k) + else + segment%tr_Reg%Tr(nt)%t(I,j,k) = tr_ptr(i,j,k) + endif + OBC%tres_x(I,j,k,nt) = I_scale * segment%tr_Reg%Tr(nt)%t(I,j,k) + enddo ; enddo + else + J=segment%HI%JsdB + do k=1,nz ; do i=segment%HI%isd,segment%HI%ied + if (segment%direction == OBC_DIRECTION_S) then + segment%tr_Reg%Tr(nt)%t(i,J,k) = tr_ptr(i,j+1,k) + else + segment%tr_Reg%Tr(nt)%t(i,J,k) = tr_ptr(i,j,k) + endif + OBC%tres_y(i,J,k,nt) = I_scale * segment%tr_Reg%Tr(nt)%t(i,J,k) + enddo ; enddo + endif + segment%tr_Reg%Tr(nt)%tres(:,:,:) = segment%tr_Reg%Tr(nt)%t(:,:,:) + enddo +end subroutine fill_obgc_segments + subroutine fill_temp_salt_segments(G, GV, US, OBC, tv) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -5104,12 +5324,11 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) integer :: i, j, k, m, n, ntr, nz integer :: ishift, idir, jshift, jdir real :: b_in, b_out ! The 0 and 1 switch for tracer reservoirs - ! 1 if the length scale of reservoir is zero [nodim] + ! 1 if the length scale of reservoir is zero [nondim] real :: a_in, a_out ! The 0 and 1(-1) switch for reservoir source weights ! e.g. a_in is -1 only if b_in ==1 and uhr or vhr is inward ! e.g. a_out is 1 only if b_out==1 and uhr or vhr is outward - ! It's clear that a_in and a_out cannot be both non-zero [nodim] - + ! It's clear that a_in and a_out cannot be both non-zero [nondim] nz = GV%ke ntr = Reg%ntr @@ -5140,9 +5359,9 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! When InvLscale_in is 0 and inflow, only nudged data is applied to reservoirs a_out = b_out * max(0.0, sign(1.0, idir*uhr(I,j,k))) a_in = b_in * min(0.0, sign(1.0, idir*uhr(I,j,k))) - u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & + u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out*segment%field(m)%resrv_lfac_out / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) - u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & + u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in*segment%field(m)%resrv_lfac_in / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) fac1 = (1.0 - (a_out - a_in)) + ((u_L_out + a_out) - (u_L_in + a_in)) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1) * & @@ -5171,9 +5390,9 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz a_out = b_out * max(0.0, sign(1.0, jdir*vhr(i,J,k))) a_in = b_in * min(0.0, sign(1.0, jdir*vhr(i,J,k))) - v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & + v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out*segment%field(m)%resrv_lfac_out / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) - v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & + v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in*segment%field(m)%resrv_lfac_in / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) fac1 = 1.0 + (v_L_out-v_L_in) fac1 = (1.0 - (a_out - a_in)) + ((v_L_out + a_out) - (v_L_in + a_in)) @@ -5190,10 +5409,188 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) end subroutine update_segment_tracer_reservoirs +!> Vertically remap the OBC tracer reservoirs and radiation rates that are filtered in time. +subroutine remap_OBC_fields(G, GV, h_old, h_new, OBC, PCM_cell) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: PCM_cell !< Use PCM remapping in cells where true + + ! Local variables + type(OBC_segment_type), pointer :: segment => NULL() ! A pointer to the various segments, used just for shorthand. + + real :: tr_column(GV%ke) ! A column of updated tracer concentrations [CU ~> Conc] + real :: r_norm_col(GV%ke) ! A column of updated radiation rates, in grid points per timestep [nondim] + real :: rxy_col(GV%ke) ! A column of updated radiation rates for oblique OBCs [L2 T-2 ~> m2 s-2] + real :: h1(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h2(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + real :: I_scale ! The inverse of the scaling factor for the tracers. + ! For salinity the units would be [ppt S-1 ~> 1]. + real :: h_neglect ! Tiny thickness used in remapping [H ~> m or kg m-2] + logical :: PCM(GV%ke) ! If true, do PCM remapping from a cell. + integer :: i, j, k, m, n, ntr, nz + + if (.not.associated(OBC)) return + + nz = GV%ke + ntr = OBC%ntr + h_neglect = GV%H_subroundoff + + if (.not.present(PCM_cell)) PCM(:) = .false. + + if (associated(OBC)) then ; if (OBC%OBC_pe) then ; do n=1,OBC%number_of_segments + segment => OBC%segment(n) + if (.not.associated(segment%tr_Reg)) cycle + + if (segment%is_E_or_W) then + I = segment%HI%IsdB + do j=segment%HI%jsd,segment%HI%jed + + ! Store a column of the start and final grids + if (segment%direction == OBC_DIRECTION_W) then + if (G%mask2dT(i+1,j) == 0.0) cycle + h1(:) = h_old(i+1,j,:) + h2(:) = h_new(i+1,j,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i+1,j,:) ; endif + else + if (G%mask2dT(i,j) == 0.0) cycle + h1(:) = h_old(i,j,:) + h2(:) = h_new(i,j,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i,j,:) ; endif + endif + + ! Vertically remap the reservoir tracer concentrations + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale + + if (present(PCM_cell)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(I,j,:), nz, h2, tr_column, & + h_neglect, h_neglect, PCM_cell=PCM) + else + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(I,j,:), nz, h2, tr_column, & + h_neglect, h_neglect) + endif + + ! Possibly underflow any very tiny tracer concentrations to 0? + + ! Update tracer concentrations + segment%tr_Reg%Tr(m)%tres(I,j,:) = tr_column(:) + if (allocated(OBC%tres_x)) then ; do k=1,nz + OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k) + enddo ; endif + + endif ; enddo + + if (segment%radiation .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%rx_norm_rad(I,j,:), nz, h2, r_norm_col, & + h_neglect, h_neglect, PCM_cell=PCM) + + do k=1,nz + segment%rx_norm_rad(I,j,k) = r_norm_col(k) + OBC%rx_normal(I,j,k) = segment%rx_norm_rad(I,j,k) + enddo + endif + + if (segment%oblique .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%rx_norm_obl(I,j,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%rx_norm_obl(I,j,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%ry_norm_obl(I,j,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%ry_norm_obl(I,j,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%cff_normal(I,j,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%cff_normal(I,j,:) = rxy_col(:) + + do k=1,nz + OBC%rx_oblique_u(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique_u(I,j,k) = segment%ry_norm_obl(I,j,k) + OBC%cff_normal_u(I,j,k) = segment%cff_normal(I,j,k) + enddo + endif + + enddo + elseif (segment%is_N_or_S) then + J = segment%HI%JsdB + do i=segment%HI%isd,segment%HI%ied + + ! Store a column of the start and final grids + if (segment%direction == OBC_DIRECTION_S) then + if (G%mask2dT(i,j+1) == 0.0) cycle + h1(:) = h_old(i,j+1,:) + h2(:) = h_new(i,j+1,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i,j+1,:) ; endif + else + if (G%mask2dT(i,j) == 0.0) cycle + h1(:) = h_old(i,j,:) + h2(:) = h_new(i,j,:) + if (present(PCM_cell)) then ; PCM(:) = PCM_cell(i,j,:) ; endif + endif + + ! Vertically remap the reservoir tracer concentrations + do m=1,ntr ; if (allocated(segment%tr_Reg%Tr(m)%tres)) then + I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale + + if (present(PCM_cell)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(i,J,:), nz, h2, tr_column, & + h_neglect, h_neglect, PCM_cell=PCM) + else + call remapping_core_h(OBC%remap_CS, nz, h1, segment%tr_Reg%Tr(m)%tres(i,J,:), nz, h2, tr_column, & + h_neglect, h_neglect) + endif + + ! Possibly underflow any very tiny tracer concentrations to 0? + + ! Update tracer concentrations + segment%tr_Reg%Tr(m)%tres(i,J,:) = tr_column(:) + if (allocated(OBC%tres_y)) then ; do k=1,nz + OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k) + enddo ; endif + + endif ; enddo + + if (segment%radiation .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%ry_norm_rad(i,J,:), nz, h2, r_norm_col, & + h_neglect, h_neglect, PCM_cell=PCM) + + do k=1,nz + segment%ry_norm_rad(i,J,k) = r_norm_col(k) + OBC%ry_normal(i,J,k) = segment%ry_norm_rad(i,J,k) + enddo + endif + + if (segment%oblique .and. (OBC%gamma_uv < 1.0)) then + call remapping_core_h(OBC%remap_CS, nz, h1, segment%rx_norm_obl(i,J,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%rx_norm_obl(i,J,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%ry_norm_obl(i,J,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%ry_norm_obl(i,J,:) = rxy_col(:) + call remapping_core_h(OBC%remap_CS, nz, h1, segment%cff_normal(i,J,:), nz, h2, rxy_col, & + h_neglect, h_neglect, PCM_cell=PCM) + segment%cff_normal(i,J,:) = rxy_col(:) + + do k=1,nz + OBC%rx_oblique_v(i,J,k) = segment%rx_norm_obl(i,J,k) + OBC%ry_oblique_v(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal_v(i,J,k) = segment%cff_normal(i,J,k) + enddo + endif + + enddo + endif + enddo ; endif ; endif + +end subroutine remap_OBC_fields + + !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_m. +!! layers are contracted to GV%Angstrom_Z. !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index 0e48cf07fd..ebe3907469 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -29,7 +29,7 @@ module MOM_porous_barriers type(diag_ctrl), pointer :: & diag => Null() !< A structure to regulate diagnostic output timing logical :: debug !< If true, write verbose checksums for debugging purposes. - real :: mask_depth !< The depth shallower than which porous barrier is not applied. + real :: mask_depth !< The depth shallower than which porous barrier is not applied [Z ~> m] integer :: eta_interp !< An integer indicating how the interface heights at the velocity !! points are calculated. Valid values are given by the parameters !! defined below: MAX, MIN, ARITHMETIC and HARMONIC. @@ -69,8 +69,8 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable !! used to dilate the layer thicknesses !! [H ~> m or kg m-2]. - type(porous_barrier_type), intent(inout) :: pbv !< porous barrier fractional cell metrics - type(porous_barrier_CS), intent(in) :: CS !< Control structure for porous barrier + type(porous_barrier_type), intent(inout) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_CS), intent(in) :: CS !< Control structure for porous barrier !local variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: eta_u ! Layer interface heights at u points [Z ~> m] @@ -80,9 +80,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points ! updated while moving up layers real :: A_layer ! Integral of fractional open width from bottom to current layer [Z ~> m] - real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. - real :: h_neglect, & ! Negligible thicknesses, often [Z ~> m] - h_min ! ! The minimum layer thickness, often [Z ~> m] + real :: h_min ! ! The minimum layer thickness [Z ~> m] real :: dmask ! The depth below which porous barrier is not applied [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -102,9 +100,7 @@ subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) call calc_eta_at_uv(eta_u, eta_v, CS%eta_interp, dmask, h, tv, G, GV, US) - Z_to_eta = 1.0 - H_to_eta = GV%H_to_m * US%m_to_Z * Z_to_eta - h_min = GV%Angstrom_H * H_to_eta + h_min = GV%Angstrom_H * GV%H_to_Z ! u-points do j=js,je ; do I=Isq,Ieq ; do_I(I,j) = .False. ; enddo ; enddo @@ -203,8 +199,6 @@ subroutine porous_widths_interface(h, tv, G, GV, US, pbv, CS, eta_bt) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: eta_v ! Layer interface height at v points [Z ~> m] logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points ! updated while moving up layers - real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. - real :: h_neglect ! Negligible thicknesses, often [Z ~> m] real :: dmask ! The depth below which porous barrier is not applied [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -291,9 +285,8 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: eta_v !< Layer interface heights at v points [Z ~> m] ! local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m or 1/eta_to_m]. - real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. - real :: h_neglect ! Negligible thicknesses, often [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m]. + real :: h_neglect ! Negligible thicknesses [Z ~> m] integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc; ie = G%iec; js = G%jsc; je = G%jec; nk = GV%ke @@ -302,9 +295,7 @@ subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt) ! currently no treatment for using optional find_eta arguments if present call find_eta(h, tv, G, GV, US, eta, halo_size=1) - Z_to_eta = 1.0 - H_to_eta = GV%H_to_m * US%m_to_Z * Z_to_eta - h_neglect = GV%H_subroundoff * H_to_eta + h_neglect = GV%H_subroundoff * GV%H_to_Z do K=1,nk+1 do j=js,je ; do I=Isq,Ieq ; eta_u(I,j,K) = dmask ; enddo ; enddo @@ -365,8 +356,8 @@ subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, A_layer, do_next) logical, intent(out) :: do_next !< False if eta_layer>D_max ! local variables - real :: m, & ! convenience constant for fit [nondim] - zeta ! normalized vertical coordinate [nondim] + real :: m ! convenience constant for fit [nondim] + real :: zeta ! normalized vertical coordinate [nondim] do_next = .True. if (eta_layer <= D_min) then @@ -398,8 +389,8 @@ subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next) logical, intent(out) :: do_next !< False if eta_layer>D_max ! local variables - real :: m, a, & ! convenience constant for fit [nondim] - zeta ! normalized vertical coordinate [nondim] + real :: m, a ! convenience constants for fit [nondim] + real :: zeta ! normalized vertical coordinate [nondim] do_next = .True. if (eta_layer <= D_min) then @@ -407,12 +398,14 @@ subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next) elseif (eta_layer > D_max) then w_layer = 1.0 do_next = .False. - else + else ! The following option could be refactored for stability and efficiency (with fewer divisions) m = (D_avg - D_min) / (D_max - D_min) a = (1.0 - m) / m zeta = (eta_layer - D_min) / (D_max - D_min) if (m < 0.5) then w_layer = zeta**(1.0 / a) + ! Note that this would be safer and more efficent if it were rewritten as: + ! w_layer = zeta**( (D_avg - D_min) / (D_max - D_avg) ) elseif (m == 0.5) then w_layer = zeta else diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 index 2f67077f1e..deb878e99c 100644 --- a/src/core/MOM_stoch_eos.F90 +++ b/src/core/MOM_stoch_eos.F90 @@ -2,46 +2,44 @@ module MOM_stoch_eos ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_file_parser, only : get_param, param_file_type -use MOM_random, only : PRNG,random_2d_constructor,random_2d_norm -use MOM_time_manager, only : time_type -use MOM_io, only : vardesc, var_desc -use MOM_restart, only : MOM_restart_CS,is_new_run -use MOM_diag_mediator, only : register_diag_field,post_data,diag_ctrl,safe_alloc_ptr -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_restart, only : register_restart_field -use MOM_isopycnal_slopes,only : vert_fill_TS -!use random_numbers_mod, only : getRandomNumbers,initializeRandomNumberStream,randomNumberStream +use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL +use MOM_file_parser, only : get_param, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_isopycnal_slopes, only : vert_fill_TS +use MOM_random, only : PRNG, random_2d_constructor, random_2d_norm +use MOM_restart, only : MOM_restart_CS, register_restart_field, is_new_run, query_initialized +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 random_numbers_mod, only : getRandomNumbers, initializeRandomNumberStream, randomNumberStream implicit none; private #include public MOM_stoch_eos_init public MOM_stoch_eos_run +public stoch_EOS_register_restarts +public post_stoch_EOS_diags public MOM_calc_varT !> Describes parameters of the stochastic component of the EOS !! correction, described in Stanley et al. JAMES 2020. -type, public :: MOM_stoch_eos_CS - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: l2_inv - !< One over sum of the T cell side side lengths squared - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: rgauss - !< nondimensional random Gaussian - real :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 - real :: amplitude=0.624499 !< Nondimensional std dev of Gaussian +type, public :: MOM_stoch_eos_CS ; private + real, allocatable :: l2_inv(:,:) !< One over sum of the T cell side side lengths squared [L-2 ~> m-2] + real, allocatable :: rgauss(:,:) !< nondimensional random Gaussian [nondim] + real :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7 [nondim] + real :: amplitude=0.624499 !< Nondimensional standard deviation of Gaussian [nondim] integer :: seed !< PRNG seed type(PRNG) :: rn_CS !< PRNG control structure - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: pattern - !< Random pattern for stochastic EOS [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: phi - !< temporal correlation stochastic EOS [nondim] + real, allocatable :: pattern(:,:) !< Random pattern for stochastic EOS [nondim] + real, allocatable :: phi(:,:) !< temporal correlation stochastic EOS [nondim] logical :: use_stoch_eos!< If true, use the stochastic equation of state (Stanley et al. 2020) real :: stanley_coeff !< Coefficient correlating the temperature gradient - !! and SGS T variance; if <0, turn off scheme in all codes - real :: stanley_a !< a in exp(aX) in stochastic coefficient + !! and SGS T variance [nondim]; if <0, turn off scheme in all codes + real :: stanley_a !< a in exp(aX) in stochastic coefficient [nondim] real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] !>@{ Diagnostic IDs @@ -52,61 +50,64 @@ module MOM_stoch_eos contains -!> Initializes MOM_stoch_eos module. -subroutine MOM_stoch_eos_init(G, Time, param_file, CS, restart_CS, diag) - type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(time_type), intent(in) :: Time !< Time for stochastic process - type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure - type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics +!> Initializes MOM_stoch_eos module, returning a logical indicating whether this module will be used. +logical function MOM_stoch_eos_init(Time, G, US, param_file, diag, CS, restart_CS) + type(time_type), intent(in) :: Time !< Time for stochastic process + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(diag_ctrl), target, intent(inout) :: diag !< Structure used to control diagnostics + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! local variables integer :: i,j - type(vardesc) :: vd - CS%seed=0 - ! contants - !pi=2*acos(0.0) + + MOM_stoch_eos_init = .false. + + CS%seed = 0 + call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", CS%use_stoch_eos, & "If true, stochastic perturbations are applied "//& "to the EOS in the PGF.", default=.false.) call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, & "Coefficient correlating the temperature gradient "//& - "and SGS T variance.", default=-1.0) + "and SGS T variance.", units="nondim", default=-1.0) call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", CS%stanley_a, & "Coefficient a which scales chi in stochastic perturbation of the "//& - "SGS T variance.", default=1.0) + "SGS T variance.", units="nondim", default=1.0, & + do_not_log=((CS%stanley_coeff<0.0) .or. .not.CS%use_stoch_eos)) call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6) + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s, & + do_not_log=(CS%stanley_coeff<0.0)) - !don't run anything if STANLEY_COEFF < 0 + ! Don't run anything if STANLEY_COEFF < 0 if (CS%stanley_coeff >= 0.0) then + if (.not.allocated(CS%pattern)) call MOM_error(FATAL, & + "MOM_stoch_eos_CS%pattern is not allocated when it should be, suggesting that "//& + "stoch_EOS_register_restarts() has not been called before MOM_stoch_eos_init().") - ALLOC_(CS%pattern(G%isd:G%ied,G%jsd:G%jed)) ; CS%pattern(:,:) = 0.0 - vd = var_desc("stoch_eos_pattern","nondim","Random pattern for stoch EOS",'h','1') - call register_restart_field(CS%pattern, vd, .false., restart_CS) - ALLOC_(CS%phi(G%isd:G%ied,G%jsd:G%jed)) ; CS%phi(:,:) = 0.0 - ALLOC_(CS%l2_inv(G%isd:G%ied,G%jsd:G%jed)) - ALLOC_(CS%rgauss(G%isd:G%ied,G%jsd:G%jed)) + allocate(CS%phi(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%l2_inv(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%rgauss(G%isd:G%ied,G%jsd:G%jed), source=0.0) call get_param(param_file, "MOM_stoch_eos", "SEED_STOCH_EOS", CS%seed, & "Specfied seed for random number sequence ", default=0) call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed) call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss) - ! fill array with approximation of grid area needed for decorrelation - ! time-scale calculation + ! fill array with approximation of grid area needed for decorrelation time-scale calculation do j=G%jsc,G%jec do i=G%isc,G%iec - CS%l2_inv(i,j)=1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) + CS%l2_inv(i,j) = 1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2) enddo enddo - if (is_new_run(restart_CS)) then - do j=G%jsc,G%jec - do i=G%isc,G%iec - CS%pattern(i,j)=CS%amplitude*CS%rgauss(i,j) - enddo - enddo + + if (.not.query_initialized(CS%pattern, "stoch_eos_pattern", restart_CS) .or. & + is_new_run(restart_CS)) then + do j=G%jsc,G%jec ; do i=G%isc,G%iec + CS%pattern(i,j) = CS%amplitude*CS%rgauss(i,j) + enddo ; enddo endif !register diagnostics @@ -120,10 +121,32 @@ subroutine MOM_stoch_eos_init(G, Time, param_file, CS, restart_CS, diag) endif endif -end subroutine MOM_stoch_eos_init + ! This module is only used if explicitly enabled or a positive correlation coefficient is set. + MOM_stoch_eos_init = CS%use_stoch_eos .or. (CS%stanley_coeff >= 0.0) + +end function MOM_stoch_eos_init + +!> Register fields related to the stoch_EOS module for resarts +subroutine stoch_EOS_register_restarts(HI, param_file, CS, restart_CS) + type(hor_index_type), intent(in) :: HI !< Horizontal index structure + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + + call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, & + "Coefficient correlating the temperature gradient "//& + "and SGS T variance.", units="nondim", default=-1.0, do_not_log=.true.) + + if (CS%stanley_coeff >= 0.0) then + allocate(CS%pattern(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.0) + call register_restart_field(CS%pattern, "stoch_eos_pattern", .false., restart_CS, & + "Random pattern for stoch EOS", "nondim") + endif + +end subroutine stoch_EOS_register_restarts !> Generates a pattern in space and time for the ocean stochastic equation of state -subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) +subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1]. @@ -132,12 +155,14 @@ subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) real, intent(in) :: delt !< Time step size for AR1 process [T ~> s]. type(time_type), intent(in) :: Time !< Time for stochastic process type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics ! local variables - integer :: i,j - integer :: yr,mo,dy,hr,mn,sc - real :: phi,ubar,vbar + real :: ubar, vbar ! Averaged velocities [L T-1 ~> m s-1] + real :: phi ! A temporal correlation factor [nondim] + integer :: i, j + + ! Return without doing anything if this capability is not enabled. + if (.not.CS%use_stoch_eos) return call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed) call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss) @@ -145,16 +170,28 @@ subroutine MOM_stoch_eos_run(G, u, v, delt, Time, CS, diag) ! advance AR(1) do j=G%jsc,G%jec do i=G%isc,G%iec - ubar=0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) - vbar=0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) - phi=exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j))) - CS%pattern(i,j)=phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j) - CS%phi(i,j)=phi + ubar = 0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j)) + vbar = 0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1)) + phi = exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j))) + CS%pattern(i,j) = phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j) + CS%phi(i,j) = phi enddo enddo end subroutine MOM_stoch_eos_run +!> Write out any diagnostics related to this module. +subroutine post_stoch_EOS_diags(CS, tv, diag) + type(MOM_stoch_eos_CS), intent(in) :: CS !< Stochastic control structure + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + type(diag_ctrl), intent(inout) :: diag !< Structure to control diagnostics + + if (CS%id_stoch_eos > 0) call post_data(CS%id_stoch_eos, CS%pattern, diag) + if (CS%id_stoch_phi > 0) call post_data(CS%id_stoch_phi, CS%phi, diag) + if (CS%id_tvar_sgs > 0) call post_data(CS%id_tvar_sgs, tv%varT, diag) + +end subroutine post_stoch_EOS_diags + !> Computes a parameterization of the SGS temperature variance subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -171,15 +208,17 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) !! in massless layers filled vertically by diffusion. S !> The filled salinity [S ~> ppt], with the values in !! in massless layers filled vertically by diffusion. - integer :: i, j, k real :: hl(5) !> Copy of local stencil of H [H ~> m] real :: dTdi2, dTdj2 !> Differences in T variance [C2 ~> degC2] + integer :: i, j, k + + ! Nothing happens if a negative correlation coefficient is set. + if (CS%stanley_coeff < 0.0) return ! This block does a thickness weighted variance calculation and helps control for ! extreme gradients along layers which are vanished against topography. It is ! still a poor approximation in the interior when coordinates are strongly tilted. - if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke) - + if (.not. associated(tv%varT)) allocate(tv%varT(G%isd:G%ied, G%jsd:G%jed, GV%ke), source=0.0) call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.) do k=1,G%ke @@ -193,12 +232,12 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) ! SGS variance in i-direction [C2 ~> degC2] dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) & - + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & - ) * G%dxT(i,j) * 0.5 )**2 + + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) & + ) * G%dxT(i,j) * 0.5 )**2 ! SGS variance in j-direction [C2 ~> degC2] dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) & - + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & - ) * G%dyT(i,j) * 0.5 )**2 + + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) & + ) * G%dyT(i,j) * 0.5 )**2 tv%varT(i,j,k) = CS%stanley_coeff * ( dTdi2 + dTdj2 ) ! Turn off scheme near land tv%varT(i,j,k) = tv%varT(i,j,k) * (minval(hl) / (maxval(hl) + GV%H_subroundoff)) @@ -210,7 +249,7 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) do k=1,G%ke do j=G%jsc,G%jec do i=G%isc,G%iec - tv%varT(i,j,k) = exp (CS%stanley_a * CS%pattern(i,j)) * tv%varT(i,j,k) + tv%varT(i,j,k) = exp(CS%stanley_a * CS%pattern(i,j)) * tv%varT(i,j,k) enddo enddo enddo diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 8f8da21ef3..b8e213fa62 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -133,6 +133,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) ! Copy various scalar variables and strings. oG%x_axis_units = dG%x_axis_units ; oG%y_axis_units = dG%y_axis_units + oG%x_ax_unit_short = dG%x_ax_unit_short ; oG%y_ax_unit_short = dG%y_ax_unit_short oG%areaT_global = dG%areaT_global ; oG%IareaT_global = dG%IareaT_global oG%south_lat = dG%south_lat ; oG%west_lon = dG%west_lon oG%len_lat = dG%len_lat ; oG%len_lon = dG%len_lon @@ -291,6 +292,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) ! Copy various scalar variables and strings. dG%x_axis_units = oG%x_axis_units ; dG%y_axis_units = oG%y_axis_units + dG%x_ax_unit_short = oG%x_ax_unit_short ; dG%y_ax_unit_short = oG%y_ax_unit_short dG%areaT_global = oG%areaT_global ; dG%IareaT_global = oG%IareaT_global dG%south_lat = oG%south_lat ; dG%west_lon = oG%west_lon dG%len_lat = oG%len_lat ; dG%len_lon = oG%len_lon diff --git a/src/core/MOM_unit_tests.F90 b/src/core/MOM_unit_tests.F90 index b962606410..d13be05ffd 100644 --- a/src/core/MOM_unit_tests.F90 +++ b/src/core/MOM_unit_tests.F90 @@ -8,7 +8,6 @@ module MOM_unit_tests use MOM_string_functions, only : string_functions_unit_tests use MOM_remapping, only : remapping_unit_tests use MOM_neutral_diffusion, only : neutral_diffusion_unit_tests -use MOM_diag_vkernels, only : diag_vkernels_unit_tests use MOM_random, only : random_unit_tests use MOM_hor_bnd_diffusion, only : near_boundary_unit_tests use MOM_CFC_cap, only : CFC_cap_unit_tests @@ -35,8 +34,6 @@ subroutine unit_tests(verbosity) "MOM_unit_tests: remapping_unit_tests FAILED") if (neutral_diffusion_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: neutralDiffusionUnitTests FAILED") - if (diag_vkernels_unit_tests(verbose)) call MOM_error(FATAL, & - "MOM_unit_tests: diag_vkernels_unit_tests FAILED") if (random_unit_tests(verbose)) call MOM_error(FATAL, & "MOM_unit_tests: random_unit_tests FAILED") if (near_boundary_unit_tests(verbose)) call MOM_error(FATAL, & diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index b586d09a09..bf4b33af11 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -99,7 +99,7 @@ module MOM_variables real, dimension(:,:), pointer :: salt_deficit => NULL() !< The salt needed to maintain the ocean column !! at a minimum salinity of MIN_SALINITY since the last time - !! that calculate_surface_state was called, [ppt R Z ~> gSalt m-2]. + !! that calculate_surface_state was called, [S R Z ~> gSalt m-2]. real, dimension(:,:), pointer :: TempxPmE => NULL() !< The net inflow of water into the ocean times the !! temperature at which this inflow occurs since the @@ -166,6 +166,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_visc_gl90 => NULL(), &!< Zonal acceleration due to GL90 vertical viscosity + ! (is included in du_dt_visc) [L T-2 ~> m s-2] + dv_dt_visc_gl90 => NULL(), &!< Meridional acceleration due to GL90 vertical viscosity + ! (is included in dv_dt_visc) [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 diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 2df65f09aa..f20c7bbd26 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -105,7 +105,7 @@ subroutine verticalGridInit( param_file, GV, US ) log_to_all=.true., debugging=.true.) call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%Z_to_m*US%m_s_to_L_T**2) + units="m s-2", default=9.80, scale=US%Z_to_m*US%m_s_to_L_T**2) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -114,9 +114,9 @@ subroutine verticalGridInit( param_file, GV, US ) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) - call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_m, & + call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_Z, & "The minimum layer thickness, usually one-Angstrom.", & - units="m", default=1.0e-10) + units="m", default=1.0e-10, scale=US%m_to_Z) call get_param(param_file, mdl, "H_RESCALE_POWER", H_power, & "An integer power of 2 that is used to rescale the model's "//& "intenal units of thickness. Valid values range from -300 to 300.", & @@ -156,13 +156,13 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_kg_m2 = US%R_to_kg_m3*GV%Rho0 * GV%H_to_m GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = 1.0 / GV%H_to_m - GV%Angstrom_H = GV%m_to_H * GV%Angstrom_m + GV%Angstrom_H = GV%m_to_H * US%Z_to_m*GV%Angstrom_Z GV%H_to_MKS = GV%H_to_m else GV%kg_m2_to_H = 1.0 / GV%H_to_kg_m2 GV%m_to_H = US%R_to_kg_m3*GV%Rho0 * GV%kg_m2_to_H GV%H_to_m = GV%H_to_kg_m2 / (US%R_to_kg_m3*GV%Rho0) - GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H + GV%Angstrom_H = US%Z_to_m*GV%Angstrom_Z * 1000.0*GV%kg_m2_to_H GV%H_to_MKS = GV%H_to_kg_m2 endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) @@ -170,15 +170,15 @@ subroutine verticalGridInit( param_file, GV, US ) GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H - GV%Angstrom_Z = US%m_to_Z * GV%Angstrom_m + GV%Angstrom_m = US%Z_to_m * GV%Angstrom_Z GV%H_to_RZ = GV%H_to_kg_m2 * US%kg_m3_to_R * US%m_to_Z GV%RZ_to_H = GV%kg_m2_to_H * US%R_to_kg_m3 * US%Z_to_m ! Log derivative values. - call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor) - call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H) - call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m) + call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H*H_rescale_factor, units="H m-1") + call log_param(param_file, mdl, "M to THICKNESS rescaled by 2^-n", GV%m_to_H, units="2^n H m-1") + call log_param(param_file, mdl, "THICKNESS to M rescaled by 2^n", GV%H_to_m, units="2^-n m H-1") allocate( GV%sInterface(nk+1) ) allocate( GV%sLayer(nk) ) diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index fd7e891e82..15e555ee37 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -76,11 +76,11 @@ module MOM_debugging contains !> MOM_debugging_init initializes the MOM_debugging module, and sets -!! the parameterts that control which checks are active for MOM6. +!! the parameters that control which checks are active for MOM6. subroutine MOM_debugging_init(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! 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_debugging" ! This module's name. call log_version(param_file, mdl, version, debugging=.true.) @@ -102,19 +102,24 @@ end subroutine MOM_debugging_init !> Check for consistency between the duplicated points of a 3-D C-grid vector subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] + ! Local variables character(len=24) :: mesg_k integer :: k @@ -126,30 +131,37 @@ subroutine check_redundant_vC3d(mesg, u_comp, v_comp, G, is, ie, js, je, & else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_vC2d(trim(mesg)//trim(mesg_k), u_comp(:,:,k), & - v_comp(:,:,k), G, is, ie, js, je, direction) + v_comp(:,:,k), G, is, ie, js, je, direction, unscale) enddo end subroutine check_redundant_vC3d !> Check for consistency between the duplicated points of a 2-D C-grid vector subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed) - real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input vector while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of u_comp [A ~> a] + real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of v_comp [A ~> a] + real :: u_resym(G%IsdB:G%IedB,G%jsd:G%jed) ! A reconstructed symmetric version of u_comp [A ~> a] + real :: v_resym(G%isd:G%ied,G%JsdB:G%JedB) ! A reconstructed symmetric version of v_comp [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -163,6 +175,8 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if ((isd == IsdB) .and. (jsd == JsdB)) return endif + sc = 1.0 ; if (present(unscale)) sc = unscale + do i=isd,ied ; do j=jsd,jed u_nonsym(i,j) = u_comp(i,j) ; v_nonsym(i,j) = v_comp(i,j) enddo ; enddo @@ -187,7 +201,7 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(3) < max_redundant_prints) then write(mesg2,'(" redundant u-components",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - u_comp(i,j), u_resym(i,j),u_comp(i,j)-u_resym(i,j),i,j,pe_here() + sc*u_comp(i,j), sc*u_resym(i,j), sc*(u_comp(i,j)-u_resym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(3) = redundant_prints(3) + 1 endif @@ -197,7 +211,7 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(3) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & - v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, & + sc*v_comp(i,j), sc*v_resym(i,j), sc*(v_comp(i,j)-v_resym(i,j)), i, j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) redundant_prints(3) = redundant_prints(3) + 1 @@ -207,14 +221,17 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vC2d !> Check for consistency between the duplicated points of a 3-D scalar at corner points -subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k @@ -227,22 +244,28 @@ subroutine check_redundant_sB3d(mesg, array, G, is, ie, js, je) else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_sB2d(trim(mesg)//trim(mesg_k), array(:,:,k), & - G, is, ie, js, je) + G, is, ie, js, je, unscale) enddo end subroutine check_redundant_sB3d !> Check for consistency between the duplicated points of a 2-D scalar at corner points -subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: a_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of array [A ~> a] + real :: a_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) ! A reconstructed symmetric version of array [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -256,6 +279,8 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) if ((isd == IsdB) .and. (jsd == JsdB)) return endif + sc = 1.0 ; if (present(unscale)) sc = unscale + do i=isd,ied ; do j=jsd,jed a_nonsym(i,j) = array(i,j) enddo ; enddo @@ -281,7 +306,7 @@ subroutine check_redundant_sB2d(mesg, array, G, is, ie, js, je) redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" Redundant points",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - array(i,j), a_resym(i,j),array(i,j)-a_resym(i,j),i,j,pe_here() + sc*array(i,j), sc*a_resym(i,j), sc*(array(i,j)-a_resym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(2) = redundant_prints(2) + 1 endif @@ -291,19 +316,23 @@ end subroutine check_redundant_sB2d !> Check for consistency between the duplicated points of a 3-D B-grid vector subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k integer :: k @@ -315,30 +344,37 @@ subroutine check_redundant_vB3d(mesg, u_comp, v_comp, G, is, ie, js, je, & else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_vB2d(trim(mesg)//trim(mesg_k), u_comp(:,:,k), & - v_comp(:,:,k), G, is, ie, js, je, direction) + v_comp(:,:,k), G, is, ie, js, je, direction, unscale) enddo end subroutine check_redundant_vB3d !> Check for consistency between the duplicated points of a 2-D B-grid vector subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: u_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) - real :: v_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input vector while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of u_comp [A ~> a] + real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A nonsymmetric version of v_comp [A ~> a] + real :: u_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) ! A reconstructed symmetric version of u_comp [A ~> a] + real :: v_resym(G%IsdB:G%IedB,G%JsdB:G%JedB) ! A reconstructed symmetric version of v_comp [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch integer :: Isq, Ieq, Jsq, Jeq, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -352,6 +388,8 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if ((isd == IsdB) .and. (jsd == JsdB)) return endif + sc = 1.0 ; if (present(unscale)) sc = unscale + do i=isd,ied ; do j=jsd,jed u_nonsym(i,j) = u_comp(i,j) ; v_nonsym(i,j) = v_comp(i,j) enddo ; enddo @@ -377,7 +415,7 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" redundant u-components",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - u_comp(i,j), u_resym(i,j),u_comp(i,j)-u_resym(i,j),i,j,pe_here() + sc*u_comp(i,j), sc*u_resym(i,j), sc*(u_comp(i,j)-u_resym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(2) = redundant_prints(2) + 1 endif @@ -387,7 +425,7 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & - v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, & + sc*v_comp(i,j), sc*v_resym(i,j), sc*(v_comp(i,j)-v_resym(i,j)), i, j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) redundant_prints(2) = redundant_prints(2) + 1 @@ -397,14 +435,17 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vB2d !> Check for consistency between the duplicated points of a 3-D scalar at tracer points -subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%isd:,G%jsd:,:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k integer :: k @@ -416,22 +457,28 @@ subroutine check_redundant_sT3d(mesg, array, G, is, ie, js, je) else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_sT2d(trim(mesg)//trim(mesg_k), array(:,:,k), & - G, is, ie, js, je) + G, is, ie, js, je, unscale) enddo end subroutine check_redundant_sT3d !> Check for consistency between the duplicated points of a 2-D scalar at tracer points -subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) +subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: array !< The array to be checked for consistency + real, dimension(G%isd:,G%jsd:), intent(in) :: array !< The array to be checked for consistency in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: a_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A version of array with halo points updated by message passing [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch @@ -442,6 +489,8 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) if (present(is)) is_ch = is ; if (present(ie)) ie_ch = ie if (present(js)) js_ch = js ; if (present(js)) je_ch = je + sc = 1.0 ; if (present(unscale)) sc = unscale + ! This only works on points outside of the standard computational domain. if ((is_ch == G%isc) .and. (ie_ch == G%iec) .and. & (js_ch == G%jsc) .and. (je_ch == G%jec)) return @@ -457,7 +506,7 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" Redundant points",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - array(i,j), a_nonsym(i,j),array(i,j)-a_nonsym(i,j),i,j,pe_here() + sc*array(i,j), sc*a_nonsym(i,j), sc*(array(i,j)-a_nonsym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(1) = redundant_prints(1) + 1 endif @@ -467,19 +516,23 @@ end subroutine check_redundant_sT2d !> Check for consistency between the duplicated points of a 3-D A-grid vector subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables character(len=24) :: mesg_k integer :: k @@ -491,28 +544,35 @@ subroutine check_redundant_vT3d(mesg, u_comp, v_comp, G, is, ie, js, je, & else ; write(mesg_k,'(" Layer",i9," ")') k ; endif call check_redundant_vT2d(trim(mesg)//trim(mesg_k), u_comp(:,:,k), & - v_comp(:,:,k), G, is, ie, js, je, direction) + v_comp(:,:,k), G, is, ie, js, je, direction, unscale) enddo end subroutine check_redundant_vT3d !> Check for consistency between the duplicated points of a 2-D A-grid vector subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & - direction) + direction, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - !! to be checked for consistency - real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector - !! to be checked for consistency + real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: is !< The starting i-index to check integer, optional, intent(in) :: ie !< The ending i-index to check integer, optional, intent(in) :: js !< The starting j-index to check integer, optional, intent(in) :: je !< The ending j-index to check integer, optional, intent(in) :: direction !< the direction flag to be !! passed to pass_vector + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables - real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) - real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input vector while [a] indicates the unscaled (e.g., mks) units to used for output. + real :: u_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A version of u_comp with halo points updated by message passing [A ~> a] + real :: v_nonsym(G%isd:G%ied,G%jsd:G%jed) ! A version of v_comp with halo points updated by message passing [A ~> a] + real :: sc ! A factor that undoes the scaling for the arrays to give consistent output [a A-1 ~> 1] character(len=128) :: mesg2 integer :: i, j, is_ch, ie_ch, js_ch, je_ch @@ -525,6 +585,8 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if (present(is)) is_ch = is ; if (present(ie)) ie_ch = ie if (present(js)) js_ch = js ; if (present(js)) je_ch = je + sc = 1.0 ; if (present(unscale)) sc = unscale + ! This only works on points outside of the standard computational domain. if ((is_ch == G%isc) .and. (ie_ch == G%iec) .and. & (js_ch == G%jsc) .and. (je_ch == G%jec)) return @@ -540,7 +602,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" redundant u-components",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & - u_comp(i,j), u_nonsym(i,j),u_comp(i,j)-u_nonsym(i,j),i,j,pe_here() + sc*u_comp(i,j), sc*u_nonsym(i,j), sc*(u_comp(i,j)-u_nonsym(i,j)), i, j, pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) redundant_prints(1) = redundant_prints(1) + 1 endif @@ -550,7 +612,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & - v_comp(i,j), v_nonsym(i,j),v_comp(i,j)-v_nonsym(i,j),i,j, & + sc*v_comp(i,j), sc*v_nonsym(i,j), sc*(v_comp(i,j)-v_nonsym(i,j)), i, j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) redundant_prints(1) = redundant_prints(1) + 1 @@ -559,163 +621,202 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & end subroutine check_redundant_vT2d + +! It appears that none of the other routines in this file are ever called. + !> Do a checksum and redundant point check on a 3d C-grid vector. -subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_C3d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_C(mesg, u_comp, v_comp, G) + call check_redundant_C(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_C3d !> Do a checksum and redundant point check on a 2d C-grid vector. -subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_C2d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call uvchksum(mesg, u_comp, v_comp, G%HI, halos) + call uvchksum(mesg, u_comp, v_comp, G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_C(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_C(mesg, u_comp, v_comp, G) + call check_redundant_C(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_C2d !> Do a checksum and redundant point check on a 3d B-grid vector. -subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_B3d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call Bchksum(u_comp, mesg//"(u)", G%HI, halos) - call Bchksum(v_comp, mesg//"(v)", G%HI, halos) + call Bchksum(u_comp, mesg//"(u)", G%HI, halos, scale=unscale) + call Bchksum(v_comp, mesg//"(v)", G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_B(mesg, u_comp, v_comp, G) + call check_redundant_B(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_B3d ! Do a checksum and redundant point check on a 2d B-grid vector. -subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric) +subroutine chksum_vec_B2d(mesg, u_comp, v_comp, G, halos, scalars, symmetric, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%IsdB:,G%JsdB:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. logical, optional, intent(in) :: symmetric !< If true, do the checksums on the !! full symmetric computational domain. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call Bchksum(u_comp, mesg//"(u)", G%HI, halos, symmetric=symmetric) - call Bchksum(v_comp, mesg//"(v)", G%HI, halos, symmetric=symmetric) + call Bchksum(u_comp, mesg//"(u)", G%HI, halos, symmetric=symmetric, scale=unscale) + call Bchksum(v_comp, mesg//"(v)", G%HI, halos, symmetric=symmetric, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_B(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_B(mesg, u_comp, v_comp, G) + call check_redundant_B(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_B2d !> Do a checksum and redundant point check on a 3d C-grid vector. -subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_A3d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%isd:,G%jsd:,:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:,:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call hchksum(u_comp, mesg//"(u)", G%HI, halos) - call hchksum(v_comp, mesg//"(v)", G%HI, halos) + call hchksum(u_comp, mesg//"(u)", G%HI, halos, scale=unscale) + call hchksum(v_comp, mesg//"(v)", G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_T(mesg, u_comp, v_comp, G) + call check_redundant_T(mesg, u_comp, v_comp, G, unscale=unscale) endif endif end subroutine chksum_vec_A3d !> Do a checksum and redundant point check on a 2d C-grid vector. -subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars) +subroutine chksum_vec_A2d(mesg, u_comp, v_comp, G, halos, scalars, unscale) character(len=*), intent(in) :: mesg !< An identifying message type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector - real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector + real, dimension(G%isd:,G%jsd:), intent(in) :: u_comp !< The u-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] + real, dimension(G%isd:,G%jsd:), intent(in) :: v_comp !< The v-component of the vector to be + !! checked for consistency in arbitrary, + !! possibly rescaled units [A ~> a] integer, optional, intent(in) :: halos !< The width of halos to check (default 0) logical, optional, intent(in) :: scalars !< If true this is a pair of !! scalars that are being checked. + real, optional, intent(in) :: unscale !< A factor that undoes the scaling for the + !! arrays to give consistent output [a A-1 ~> 1] ! Local variables logical :: are_scalars are_scalars = .false. ; if (present(scalars)) are_scalars = scalars if (debug_chksums) then - call hchksum(u_comp, mesg//"(u)", G%HI, halos) - call hchksum(v_comp, mesg//"(v)", G%HI, halos) + call hchksum(u_comp, mesg//"(u)", G%HI, halos, scale=unscale) + call hchksum(v_comp, mesg//"(v)", G%HI, halos, scale=unscale) endif if (debug_redundant) then if (are_scalars) then - call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair) + call check_redundant_T(mesg, u_comp, v_comp, G, direction=To_All+Scalar_Pair, unscale=unscale) else - call check_redundant_T(mesg, u_comp, v_comp, G) + call check_redundant_T(mesg, u_comp, v_comp, G, unscale=unscale) endif endif @@ -725,12 +826,12 @@ end subroutine chksum_vec_A2d !! processors of hThick*stuff, where stuff is a 3-d array at tracer points. function totalStuff(HI, hThick, areaT, stuff) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights [m] real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas [m2] - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed - real :: totalStuff !< the globally integrated amoutn of stuff + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: stuff !< The array of stuff to be summed in arbitrary units [a] + real :: totalStuff !< the globally integrated amount of stuff [a m3] ! Local variables - real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum + real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum ! The column integrated amount of stuff in a cell [a m3] integer :: i, j, k, nz nz = size(hThick,3) @@ -746,18 +847,22 @@ end function totalStuff !! as well as the change since the last call. subroutine totalTandS(HI, hThick, areaT, temperature, salinity, mesg) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: hThick !< The array of thicknesses to use as weights [m] real, dimension(HI%isd:,HI%jsd:), intent(in) :: areaT !< The array of cell areas [m2] - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: temperature !< The temperature field to sum [degC] + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: salinity !< The salinity field to sum [ppt] character(len=*), intent(in) :: mesg !< An identifying message ! NOTE: This subroutine uses "save" data which is not thread safe and is purely for ! extreme debugging without a proper debugger. - real, save :: totalH = 0., totalT = 0., totalS = 0. + real, save :: totalH = 0. ! The total ocean volume, saved for the next call [m3] + real, save :: totalT = 0. ! The total volume integrated ocean temperature, saved for the next call [degC m3] + real, save :: totalS = 0. ! The total volume integrated ocean salinity, saved for the next call [ppt m3] ! Local variables logical, save :: firstCall = .true. - real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum - real :: thisH, thisT, thisS, delH, delT, delS + real, dimension(HI%isc:HI%iec, HI%jsc:HI%jec) :: tmp_for_sum ! The volume of each column [m3] + real :: thisH, delH ! The total ocean volume and the change from the last call [m3] + real :: thisT, delT ! The current total volume integrated temperature and the change from the last call [degC m3] + real :: thisS, delS ! The current total volume integrated salinity and the change from the last call [ppt m3] integer :: i, j, k, nz nz = size(hThick,3) @@ -788,11 +893,13 @@ end subroutine totalTandS !> Returns false if the column integral of a given quantity is within roundoff logical function check_column_integral(nk, field, known_answer) integer, intent(in) :: nk !< Number of levels in column - real, dimension(nk), intent(in) :: field !< Field to be summed - real, optional, intent(in) :: known_answer !< If present is the expected sum, + real, dimension(nk), intent(in) :: field !< Field to be summed [arbitrary] + real, optional, intent(in) :: known_answer !< If present is the expected sum [arbitrary], !! If missing, assumed zero ! Local variables - real :: u_sum, error, expected + real :: u_sum ! The vertical sum of the field [arbitrary] + real :: error ! An estimate of the roundoff error in the sum [arbitrary] + real :: expected ! The expected vertical sum [arbitrary] integer :: k u_sum = field(1) @@ -824,12 +931,15 @@ end function check_column_integral logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_value) integer, intent(in) :: nk_1 !< Number of levels in field 1 integer, intent(in) :: nk_2 !< Number of levels in field 2 - real, dimension(nk_1), intent(in) :: field_1 !< First field to be summed - real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed + real, dimension(nk_1), intent(in) :: field_1 !< First field to be summed [arbitrary] + real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed [arbitrary] real, optional, intent(in) :: missing_value !< If column contains missing values, - !! mask them from the sum + !! mask them from the sum [arbitrary] ! Local variables - real :: u1_sum, error1, u2_sum, error2, misval + real :: u1_sum, u2_sum ! The vertical sums of the two fields [arbitrary] + real :: error1, error2 ! Estimates of the roundoff errors in the sums [arbitrary] + real :: misval ! The missing value flag, indicating elements that are to be omitted + ! from the sums [arbitrary] integer :: k ! Assign missing value @@ -844,7 +954,7 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_va ! Reintegrate and sum roundoff errors do k=2,nk_1 - if (field_1(k)/=misval) then + if (field_1(k) /= misval) then u1_sum = u1_sum + field_1(k) error1 = error1 + EPSILON(u1_sum)*MAX(ABS(u1_sum),ABS(field_1(k))) endif @@ -855,7 +965,7 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_va ! Reintegrate and sum roundoff errors do k=2,nk_2 - if (field_2(k)/=misval) then + if (field_2(k) /= misval) then u2_sum = u2_sum + field_2(k) error2 = error2 + EPSILON(u2_sum)*MAX(ABS(u2_sum),ABS(field_2(k))) endif diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index ad51ecfe5e..ff65a3b60b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -54,7 +54,7 @@ module MOM_diagnostics logical :: initialized = .false. !< True if this control structure has been initialized. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as !! monotonic for the purposes of calculating the equivalent - !! barotropic wave speed. + !! barotropic wave speed [nondim]. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed [Z ~> m]. @@ -83,6 +83,7 @@ module MOM_diagnostics integer :: id_PE_to_KE = -1, id_KE_BT = -1 integer :: id_KE_Coradv = -1, id_KE_adv = -1 integer :: id_KE_visc = -1, id_KE_stress = -1 + integer :: id_KE_visc_gl90 = -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 @@ -202,7 +203,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! including [nondim] and [H ~> m or kg m-2]. real :: uh_tmp(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary zonal transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vh_tmp(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary meridional transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. + real :: mass_cell(SZI_(G),SZJ_(G)) ! The vertically integrated mass in a grid cell [kg] real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] real :: cg1(SZI_(G),SZJ_(G)) ! First baroclinic gravity wave speed [L T-1 ~> m s-1] real :: Rd1(SZI_(G),SZJ_(G)) ! First baroclinic deformation radius [L ~> m] @@ -220,13 +221,13 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & integer :: k_list - real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [degC] - real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [degC] - real :: thetaoga ! The volume mean potential temperature [degC] - real :: soga ! The volume mean ocean salinity [ppt] + real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [C ~> degC] + real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [S ~> ppt] + real :: thetaoga ! The volume mean potential temperature [C ~> degC] + real :: soga ! The volume mean ocean salinity [S ~> ppt] real :: masso ! The total mass of the ocean [kg] - real :: tosga ! The area mean sea surface temperature [degC] - real :: sosga ! The area mean sea surface salinity [ppt] + real :: tosga ! The area mean sea surface temperature [C ~> degC] + real :: sosga ! The area mean sea surface salinity [S ~> ppt] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -333,11 +334,11 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! mass of liquid ocean (for Bouss, use Rho0). The reproducing sum requires the use of MKS units. if (CS%id_masso > 0) then - work_2d(:,:) = 0.0 + mass_cell(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - work_2d(i,j) = work_2d(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) + mass_cell(i,j) = mass_cell(i,j) + (GV%H_to_kg_m2*h(i,j,k)) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo ; enddo - masso = reproducing_sum(work_2d) + masso = reproducing_sum(mass_cell) call post_data(CS%id_masso, masso, CS%diag) endif @@ -457,37 +458,37 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! volume mean potential temperature if (CS%id_thetaoga>0) then - thetaoga = global_volume_mean(tv%T, h, G, GV, scale=US%C_to_degC) + thetaoga = global_volume_mean(tv%T, h, G, GV, tmp_scale=US%C_to_degC) call post_data(CS%id_thetaoga, thetaoga, CS%diag) endif ! area mean SST if (CS%id_tosga > 0) then - tosga = global_area_mean(tv%T(:,:,1), G, scale=US%C_to_degC) + tosga = global_area_mean(tv%T(:,:,1), G, tmp_scale=US%C_to_degC) call post_data(CS%id_tosga, tosga, CS%diag) endif ! volume mean salinity if (CS%id_soga>0) then - soga = global_volume_mean(tv%S, h, G, GV, scale=US%S_to_ppt) + soga = global_volume_mean(tv%S, h, G, GV, tmp_scale=US%S_to_ppt) call post_data(CS%id_soga, soga, CS%diag) endif ! area mean SSS if (CS%id_sosga > 0) then - sosga = global_area_mean(tv%S(:,:,1), G, scale=US%S_to_ppt) + sosga = global_area_mean(tv%S(:,:,1), G, tmp_scale=US%S_to_ppt) call post_data(CS%id_sosga, sosga, CS%diag) endif ! layer mean potential temperature if (CS%id_temp_layer_ave>0) then - temp_layer_ave = global_layer_mean(tv%T, h, G, GV, scale=US%C_to_degC) + temp_layer_ave = global_layer_mean(tv%T, h, G, GV, tmp_scale=US%C_to_degC) call post_data(CS%id_temp_layer_ave, temp_layer_ave, CS%diag) endif ! layer mean salinity if (CS%id_salt_layer_ave>0) then - salt_layer_ave = global_layer_mean(tv%S, h, G, GV, scale=US%S_to_ppt) + salt_layer_ave = global_layer_mean(tv%S, h, G, GV, tmp_scale=US%S_to_ppt) call post_data(CS%id_salt_layer_ave, salt_layer_ave, CS%diag) endif @@ -833,7 +834,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a !! previous call to diagnostics_init. - real, dimension(SZI_(G), SZJ_(G)) :: & + real, dimension(SZI_(G),SZJ_(G)) :: & z_top, & ! Height of the top of a layer or the ocean [Z ~> m]. z_bot, & ! Height of the bottom of a layer (for id_mass) or the ! (positive) depth of the ocean (for id_col_ht) [Z ~> m]. @@ -890,7 +891,6 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) if (GV%Boussinesq) then if (associated(tv%eqn_of_state)) then IG_Earth = 1.0 / GV%g_Earth -! do j=js,je ; do i=is,ie ; z_bot(i,j) = -P_SURF(i,j)/GV%H_to_Pa ; enddo ; enddo do j=G%jscB,G%jecB+1 ; do i=G%iscB,G%iecB+1 z_bot(i,j) = 0.0 enddo ; enddo @@ -1121,6 +1121,25 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS call post_data(CS%id_KE_visc, KE_term, CS%diag) endif + if (CS%id_KE_visc_gl90 > 0) then + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + do k=1,nz + do j=js,je ; do I=Isq,Ieq + KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie + KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_visc_gl90(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 + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1))) + enddo ; enddo + enddo + call post_data(CS%id_KE_visc_gl90, KE_term, CS%diag) + endif + if (CS%id_KE_stress > 0) then ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. do k=1,nz @@ -1187,9 +1206,10 @@ end subroutine calculate_energy_diagnostics subroutine register_time_deriv(lb, f_ptr, deriv_ptr, CS) integer, intent(in), dimension(3) :: lb !< Lower index bound of f_ptr real, dimension(lb(1):,lb(2):,:), target :: f_ptr - !< Time derivative operand + !< Time derivative operand, in arbitrary units [A ~> a] real, dimension(lb(1):,lb(2):,:), target :: deriv_ptr - !< Time derivative of f_ptr + !< Time derivative of f_ptr, in units derived from + !! the arbitrary units of f_ptr [A T-1 ~> a s-1] type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to !! diagnostics_init. @@ -1309,7 +1329,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections !! for ice displacement and the inverse barometer [Z ~> m] - real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array [various] real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [Z ~> m] real :: I_time_int ! The inverse of the time interval [T-1 ~> s-1]. @@ -1455,10 +1475,10 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy type(tracer_registry_type), pointer :: Reg !< Pointer to the tracer registry ! Local variables - real, dimension(SZIB_(G), SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZI_(G), SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZIB_(G), SZJ_(G),SZK_(GV)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] - real, dimension(SZI_(G), SZJB_(G),SZK_(GV)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZIB_(G),SZJ_(G)) :: umo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZI_(G),SZJB_(G)) :: vmo2d ! Diagnostics of integrated mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: umo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vmo ! Diagnostics of layer mass transport [R Z L2 T-1 ~> kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tend ! Change in layer thickness due to dynamics ! [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [T-1 ~> s-1] @@ -1617,11 +1637,11 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag flux_units = get_flux_units(GV) convert_H = GV%H_to_MKS - CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL,& + CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL, & Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & !### , conversion=GV%H_to_kg_m2, & standard_name='sea_water_mass_per_unit_area', v_extensive=.true.) - CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & + CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & diag, 'Mass of liquid ocean', 'kg', standard_name='sea_water_mass') CS%id_thkcello = register_diag_field('ocean_model', 'thkcello', diag%axesTL, Time, & @@ -1663,38 +1683,38 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag standard_name='Salinity Squared') CS%id_temp_layer_ave = register_diag_field('ocean_model', 'temp_layer_ave', & - diag%axesZL, Time, 'Layer Average Ocean Temperature', 'degC') + diag%axesZL, Time, 'Layer Average Ocean Temperature', units='degC', conversion=US%C_to_degC) CS%id_salt_layer_ave = register_diag_field('ocean_model', 'salt_layer_ave', & - diag%axesZL, Time, 'Layer Average Ocean Salinity', 'psu') + diag%axesZL, Time, 'Layer Average Ocean Salinity', units='psu', conversion=US%S_to_ppt) CS%id_thetaoga = register_scalar_field('ocean_model', 'thetaoga', & - Time, diag, 'Global Mean Ocean Potential Temperature', 'degC', & + Time, diag, 'Global Mean Ocean Potential Temperature', units='degC', conversion=US%C_to_degC, & standard_name='sea_water_potential_temperature') CS%id_soga = register_scalar_field('ocean_model', 'soga', & - Time, diag, 'Global Mean Ocean Salinity', 'psu', & + Time, diag, 'Global Mean Ocean Salinity', units='psu', conversion=US%S_to_ppt, & standard_name='sea_water_salinity') - CS%id_tosga = register_scalar_field('ocean_model', 'sst_global', Time, diag,& - long_name='Global Area Average Sea Surface Temperature', & - units='degC', standard_name='sea_surface_temperature', & - cmor_field_name='tosga', cmor_standard_name='sea_surface_temperature', & + CS%id_tosga = register_scalar_field('ocean_model', 'sst_global', Time, diag, & + long_name='Global Area Average Sea Surface Temperature', & + units='degC', conversion=US%C_to_degC, standard_name='sea_surface_temperature', & + cmor_field_name='tosga', cmor_standard_name='sea_surface_temperature', & cmor_long_name='Sea Surface Temperature') - CS%id_sosga = register_scalar_field('ocean_model', 'sss_global', Time, diag,& - long_name='Global Area Average Sea Surface Salinity', & - units='psu', standard_name='sea_surface_salinity', & - cmor_field_name='sosga', cmor_standard_name='sea_surface_salinity', & + CS%id_sosga = register_scalar_field('ocean_model', 'sss_global', Time, diag, & + long_name='Global Area Average Sea Surface Salinity', & + units='psu', conversion=US%S_to_ppt, standard_name='sea_surface_salinity', & + cmor_field_name='sosga', cmor_standard_name='sea_surface_salinity', & cmor_long_name='Sea Surface Salinity') endif - CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & + CS%id_u = register_diag_field('ocean_model', 'u', diag%axesCuL, Time, & 'Zonal velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='uo', & cmor_standard_name='sea_water_x_velocity', cmor_long_name='Sea Water X Velocity') - CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & + CS%id_v = register_diag_field('ocean_model', 'v', diag%axesCvL, Time, & 'Meridional velocity', 'm s-1', conversion=US%L_T_to_m_s, cmor_field_name='vo', & cmor_standard_name='sea_water_y_velocity', cmor_long_name='Sea Water Y Velocity') - CS%id_usq = register_diag_field('ocean_model', 'usq', diag%axesCuL, Time, & + CS%id_usq = register_diag_field('ocean_model', 'usq', diag%axesCuL, Time, & 'Zonal velocity squared', 'm2 s-2', conversion=US%L_T_to_m_s**2) - CS%id_vsq = register_diag_field('ocean_model', 'vsq', diag%axesCvL, Time, & + CS%id_vsq = register_diag_field('ocean_model', 'vsq', diag%axesCvL, Time, & 'Meridional velocity squared', 'm2 s-2', conversion=US%L_T_to_m_s**2) CS%id_uv = register_diag_field('ocean_model', 'uv', diag%axesTL, Time, & 'Product between zonal and meridional velocities at h-points', & @@ -1803,6 +1823,9 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + CS%id_KE_visc_gl90 = register_diag_field('ocean_model', 'KE_visc_gl90', diag%axesTL, Time, & + 'Kinetic Energy Source from GL90 Vertical Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) 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) @@ -1841,22 +1864,22 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag wave_speed_tol=wave_speed_tol) endif - CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & + CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & 'The column mass for calculating mass-weighted average properties', 'kg m-2', conversion=US%RZ_to_kg_m2) if (use_temperature) then - CS%id_temp_int = register_diag_field('ocean_model', 'temp_int', diag%axesT1, Time, & + CS%id_temp_int = register_diag_field('ocean_model', 'temp_int', diag%axesT1, Time, & 'Density weighted column integrated potential temperature', & 'degC kg m-2', conversion=US%C_to_degC*US%RZ_to_kg_m2, & - cmor_field_name='opottempmint', & - cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature',& + cmor_field_name='opottempmint', & + cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_potential_temperature', & cmor_standard_name='Depth integrated density times potential temperature') - CS%id_salt_int = register_diag_field('ocean_model', 'salt_int', diag%axesT1, Time, & + CS%id_salt_int = register_diag_field('ocean_model', 'salt_int', diag%axesT1, Time, & 'Density weighted column integrated salinity', & 'psu kg m-2', conversion=US%S_to_ppt*US%RZ_to_kg_m2, & - cmor_field_name='somint', & - cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_salinity',& + cmor_field_name='somint', & + cmor_long_name='integral_wrt_depth_of_product_of_sea_water_density_and_salinity', & cmor_standard_name='Depth integrated density times salinity') endif @@ -1886,18 +1909,18 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! Vertically integrated, budget, and surface state diagnostics - IDs%id_volo = register_scalar_field('ocean_model', 'volo', Time, diag,& - long_name='Total volume of liquid ocean', units='m3', & + IDs%id_volo = register_scalar_field('ocean_model', 'volo', Time, diag, & + long_name='Total volume of liquid ocean', units='m3', & standard_name='sea_water_volume') - IDs%id_zos = register_diag_field('ocean_model', 'zos', diag%axesT1, Time,& - standard_name = 'sea_surface_height_above_geoid', & + IDs%id_zos = register_diag_field('ocean_model', 'zos', diag%axesT1, Time, & + standard_name = 'sea_surface_height_above_geoid', & long_name= 'Sea surface height above geoid', units='m', conversion=US%Z_to_m) - IDs%id_zossq = register_diag_field('ocean_model', 'zossq', diag%axesT1, Time,& - standard_name='square_of_sea_surface_height_above_geoid', & + IDs%id_zossq = register_diag_field('ocean_model', 'zossq', diag%axesT1, Time, & + standard_name='square_of_sea_surface_height_above_geoid', & long_name='Square of sea surface height above geoid', units='m2', conversion=US%Z_to_m**2) IDs%id_ssh = register_diag_field('ocean_model', 'SSH', diag%axesT1, Time, & 'Sea Surface Height', 'm', conversion=US%Z_to_m) - IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag,& + IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag, & long_name='Area averaged sea surface height', units='m', conversion=US%Z_to_m, & standard_name='area_averaged_sea_surface_height') IDs%id_ssu = register_diag_field('ocean_model', 'SSU', diag%axesCu1, Time, & @@ -1908,7 +1931,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) 'Sea Surface Speed', 'm s-1', conversion=US%L_T_to_m_s) if (associated(tv%T)) then - IDs%id_sst = register_diag_field('ocean_model', 'SST', diag%axesT1, Time, & + IDs%id_sst = register_diag_field('ocean_model', 'SST', diag%axesT1, Time, & 'Sea Surface Temperature', 'degC', conversion=US%C_to_degC, & cmor_field_name='tos', cmor_long_name='Sea Surface Temperature', & cmor_standard_name='sea_surface_temperature') @@ -1925,11 +1948,11 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) cmor_field_name='sossq', cmor_long_name='Square of Sea Surface Salinity ', & cmor_standard_name='square_of_sea_surface_salinity') if (tv%T_is_conT) then - IDs%id_sstcon = register_diag_field('ocean_model', 'conSST', diag%axesT1, Time, & + IDs%id_sstcon = register_diag_field('ocean_model', 'conSST', diag%axesT1, Time, & 'Sea Surface Conservative Temperature', 'Celsius', conversion=US%C_to_degC) endif if (tv%S_is_absS) then - IDs%id_sssabs = register_diag_field('ocean_model', 'absSSS', diag%axesT1, Time, & + IDs%id_sssabs = register_diag_field('ocean_model', 'absSSS', diag%axesT1, Time, & 'Sea Surface Absolute Salinity', 'g kg-1', conversion=US%S_to_ppt) endif if (associated(tv%frazil)) then @@ -1947,7 +1970,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) IDs%id_Heat_PmE = register_diag_field('ocean_model', 'Heat_PmE', diag%axesT1, Time, & 'Heat flux into ocean from mass flux into ocean', & 'W m-2', conversion=US%QRZ_T_to_W_m2) - IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time,& + IDs%id_intern_heat = register_diag_field('ocean_model', 'internal_heat', diag%axesT1, Time, & 'Heat flux into ocean from geothermal or other internal sources', & 'W m-2', conversion=US%QRZ_T_to_W_m2) @@ -1958,15 +1981,13 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) type(time_type), intent(in) :: Time !< current model time type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(transport_diag_IDs), intent(inout) :: IDs !< A structure with the diagnostic IDs. type(diag_ctrl), intent(inout) :: diag !< regulates diagnostic output - real :: H_convert character(len=48) :: thickness_units, accum_flux_units thickness_units = get_thickness_units(GV) - H_convert = GV%H_to_MKS if (GV%Boussinesq) then accum_flux_units = "m3" else @@ -1976,10 +1997,10 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) ! Diagnostics related to tracer and mass transport IDs%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', & - accum_flux_units, y_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) + accum_flux_units, y_cell_method='sum', v_extensive=.true., conversion=GV%H_to_MKS*US%L_to_m**2) IDs%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', & - accum_flux_units, x_cell_method='sum', v_extensive=.true., conversion=H_convert*US%L_to_m**2) + accum_flux_units, x_cell_method='sum', v_extensive=.true., conversion=GV%H_to_MKS*US%L_to_m**2) IDs%id_umo = register_diag_field('ocean_model', 'umo', & diag%axesCuL, Time, 'Ocean Mass X Transport', & 'kg s-1', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2, & @@ -1996,10 +2017,10 @@ subroutine register_transport_diags(Time, G, GV, US, IDs, diag) diag%axesCv1, Time, 'Ocean Mass Y Transport Vertical Sum', & 'kg s-1', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2, & standard_name='ocean_mass_y_transport_vertical_sum', x_cell_method='sum') - IDs%id_dynamics_h = register_diag_field('ocean_model','dynamics_h', & + IDs%id_dynamics_h = register_diag_field('ocean_model','dynamics_h', & diag%axesTl, Time, 'Layer thicknesses prior to horizontal dynamics', & thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.) - IDs%id_dynamics_h_tendency = register_diag_field('ocean_model','dynamics_h_tendency', & + IDs%id_dynamics_h_tendency = register_diag_field('ocean_model','dynamics_h_tendency', & diag%axesTl, Time, 'Change in layer thicknesses due to horizontal dynamics', & trim(thickness_units)//" s-1", conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) @@ -2014,7 +2035,7 @@ subroutine write_static_fields(G, GV, US, tv, diag) type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output ! Local variables - real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. + real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array [Z ~> m] integer :: id, i, j logical :: use_temperature @@ -2081,10 +2102,10 @@ subroutine write_static_fields(G, GV, US, tv, diag) x_cell_method='sum', y_cell_method='sum', area_cell_method='sum') if (id > 0) call post_data(id, G%areaBu, diag, .true.) - id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & + id = register_static_field('ocean_model', 'depth_ocean', diag%axesT1, & 'Depth of the ocean at tracer points', 'm', conversion=US%Z_to_m, & - standard_name='sea_floor_depth_below_geoid', & - cmor_field_name='deptho', cmor_long_name='Sea Floor Depth', & + standard_name='sea_floor_depth_below_geoid', & + 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) then @@ -2231,7 +2252,10 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) 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 (CS%id_KE_visc_gl90 > 0) then + call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + endif if (CS%id_KE_stress > 0) 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) @@ -2245,7 +2269,8 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) CS%KE_term_on = ((CS%id_dKEdt > 0) .or. (CS%id_PE_to_KE > 0) .or. (CS%id_KE_BT > 0) .or. & (CS%id_KE_Coradv > 0) .or. (CS%id_KE_adv > 0) .or. (CS%id_KE_visc > 0) .or. & - (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. (CS%id_KE_dia > 0)) + (CS%id_KE_visc_gl90 > 0) .or. (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. & + (CS%id_KE_dia > 0)) if (CS%id_h_du_dt > 0) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) if (CS%id_h_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 412fbe6de7..1f1a8e0d36 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -73,6 +73,14 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "ZSTAR_RIGID_SURFACE_THRESHOLD") call obsolete_logical(param_file, "HENYEY_IGW_BACKGROUND_NEW") + call obsolete_real(param_file, "SLIGHT_DZ_SURFACE") + call obsolete_int(param_file, "SLIGHT_NZ_SURFACE_FIXED") + call obsolete_real(param_file, "SLIGHT_SURFACE_AVG_DEPTH") + call obsolete_real(param_file, "SLIGHT_NLAY_TO_INTERIOR") + call obsolete_logical(param_file, "SLIGHT_FIX_HALOCLINES") + call obsolete_real(param_file, "HALOCLINE_FILTER_LENGTH") + call obsolete_real(param_file, "HALOCLINE_STRAT_TOL") + ! Test for inconsistent parameter settings. split = .true. ; test_logic = .false. call read_param(param_file,"SPLIT",split) @@ -83,21 +91,24 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "ETA_TOLERANCE_AUX", only_warn=.true.) call obsolete_real(param_file, "BT_MASS_SOURCE_LIMIT", 0.0) - + call obsolete_real(param_file, "FIRST_GUESS_SURFACE_LAYER_DEPTH") + call obsolete_logical(param_file, "CORRECT_SURFACE_LAYER_AVERAGE") call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") call obsolete_int(param_file, "USE_LATERAL_BOUNDARY_DIFFUSION", & hint="Use USE_HORIZONTAL_BOUNDARY_DIFFUSION instead.") call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) + call obsolete_logical(param_file, "Use_PP81", hint="get_param is case sensitive so use USE_PP81.") call obsolete_logical(param_file, "ALLOW_CLOCKS_IN_OMP_LOOPS", .true.) call obsolete_logical(param_file, "LARGE_FILE_SUPPORT", .true.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") - ! This parameter is on the to-do list to be obsoleted. - ! call obsolete_logical(param_file, "NEW_SPONGES", hint="Use INTERPOLATE_SPONGE_TIME_SPACE instead.") + call read_param(param_file, "INTERPOLATE_SPONGE_TIME_SPACE", test_logic) + call obsolete_logical(param_file, "NEW_SPONGES", warning_val=test_logic, & + hint="Use INTERPOLATE_SPONGE_TIME_SPACE instead.") call obsolete_logical(param_file, "SMOOTH_RI", hint="Instead use N_SMOOTH_RI.") @@ -116,7 +127,7 @@ subroutine obsolete_logical(param_file, varname, warning_val, hint) logical :: test_logic, fatal_err character(len=128) :: hint_msg - test_logic = .false. ; call read_param(param_file, varname,test_logic) + test_logic = .false. ; call read_param(param_file, varname, test_logic) fatal_err = .true. if (present(warning_val)) fatal_err = (warning_val .neqv. .true.) hint_msg = " " ; if (present(hint)) hint_msg = hint diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index 551b821645..ab1210c0f5 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -22,21 +22,33 @@ module MOM_spatial_means public :: global_volume_mean, global_mass_integral, global_mass_int_EFP public :: adjust_area_mean_to_zero +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + contains !> Return the global area mean of a variable. This uses reproducing sums. function global_area_mean(var, G, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G), SZJ_(G)), intent(in) :: var !< The variable to average - real, optional, intent(in) :: scale !< A rescaling factor for the variable - real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_area_mean + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums + real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the variable + !! that is reversed in the return value [a A-1 ~> 1] + real :: global_area_mean ! The mean of the variable in arbitrary unscaled units [a] or scaled units [A ~> a] ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor. + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] + real :: scalefac ! An overall scaling factor for the areas and variable [a m2 A-1 L-2 ~> 1] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -58,16 +70,23 @@ end function global_area_mean !> Return the global area mean of a variable. This uses reproducing sums. function global_area_mean_v(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: var !< The variable to average + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value + !! variable that converts it back to unscaled + !! (e.g., mks) units to enable the use of the + !! reproducing sums [a A-1 ~> 1], but is reversed + !! before output so that the return value has + !! the same units as var - real :: global_area_mean_v + real :: global_area_mean_v ! The mean of the variable in the same arbitrary units as var [A ~> a] ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] + real :: scalefac ! An overall scaling factor for the areas and variable [a m2 A-1 L-2 ~> 1] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -91,14 +110,22 @@ end function global_area_mean_v !> Return the global area mean of a variable on U grid. This uses reproducing sums. function global_area_mean_u(var, G, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: var !< The variable to average + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_area_mean_u + !! variable that converts it back to unscaled + !! (e.g., mks) units to enable the use of the + !! reproducing sums [a A-1 ~> 1], but is reversed + !! before output so that the return value has + !! the same units as var + real :: global_area_mean_u ! The mean of the variable in the same arbitrary units as var [A ~> a] - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] + real :: scalefac ! An overall scaling factor for the areas and variable [a m2 A-1 L-2 ~> 1] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -123,18 +150,24 @@ end function global_area_mean_u !! grid, but an alternate could be used instead. This uses reproducing sums. function global_area_integral(var, G, scale, area, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to integrate - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< The variable to integrate in + !! arbitrary, possibly rescaled units [A ~> a] + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: area !< The alternate area to use, including !! any required masking [L2 ~> m2]. real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_area_integral !< The returned area integral, usually in the units of var times [m2]. + !! variable that is reversed in the return value [a A-1 ~> 1] + real :: global_area_integral !< The returned area integral, usually in the units of var times an area, + !! [a m2] or [A m2 ~> a m2] depending on which optional arguments are provided ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! An unscaled cell integral [a m2] real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor. + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -163,18 +196,28 @@ end function global_area_integral function global_layer_mean(var, h, G, GV, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: var !< The variable to average in + !! arbitrary, possibly rescaled units [A ~> a] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real, dimension(SZK_(GV)) :: global_layer_mean + !! variable that is reversed in the return value [a A-1 ~> 1] + real, dimension(SZK_(GV)) :: global_layer_mean !< The mean of the variable in the arbitrary scaled [A] + !! or unscaled [a] units of var, depending on which optional + !! arguments are provided - real, dimension(G%isc:G%iec, G%jsc:G%jec, SZK_(GV)) :: tmpForSumming, weight + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(G%isc:G%iec,G%jsc:G%jec,SZK_(GV)) :: tmpForSumming ! An unscaled cell integral [a m3] + real, dimension(G%isc:G%iec,G%jsc:G%jec,SZK_(GV)) :: weight ! The volume of each cell, used as a weight [m3] type(EFP_type), dimension(2*SZK_(GV)) :: laysums - real, dimension(SZK_(GV)) :: global_temp_scalar, global_weight_scalar - real :: temp_scale ! A temporary scaling factor - real :: scalefac ! A scaling factor for the variable. + real, dimension(SZK_(GV)) :: global_temp_scalar ! The global integral of the tracer in each layer [a m3] + real, dimension(SZK_(GV)) :: global_weight_scalar ! The global integral of the volume of each layer [m3] + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -202,18 +245,26 @@ function global_volume_mean(var, h, G, GV, scale, tmp_scale) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: var !< The variable being averaged + intent(in) :: var !< The variable being averaged in + !! arbitrary, possibly rescaled units [A ~> a] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value - real :: global_volume_mean !< The thickness-weighted average of var + !! variable that is reversed in the return value [a A-1 ~> 1] + real :: global_volume_mean !< The thickness-weighted average of var in the arbitrary scaled [A] or + !! unscaled [a] units of var, depending on which optional arguments are provided - real :: temp_scale ! A temporary scaling factor - real :: scalefac ! A scaling factor for the variable. - real :: weight_here - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming, sum_weight + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real :: temp_scale ! A temporary scaling factor [a A-1 ~> 1] or [1] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: weight_here ! The volume of a grid cell [m3] + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! The volume integral of the variable in a column [a m3] + real, dimension(SZI_(G),SZJ_(G)) :: sum_weight ! The volume of each column of water [m3] integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -239,19 +290,25 @@ function global_mass_integral(h, G, GV, var, on_PE_only, scale, tmp_scale) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: var !< The variable being integrated - logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only - !! done on the local PE, and it is _not_ order invariant. - real, optional, intent(in) :: scale !< A rescaling factor for the variable + optional, intent(in) :: var !< The variable being integrated in + !! arbitrary, possibly rescaled units [A ~> a] + logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only done + !! on the local PE, and it is _not_ order invariant. + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A temporary rescaling factor for the - !! variable that is reversed in the return value + !! variable that is reversed in the return value [a A-1 ~> 1] real :: global_mass_integral !< The mass-weighted integral of var (or 1) in - !! kg times the units of var + !! kg times the arbitrary units of var [kg a] or [kg A ~> kg a] - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming - real :: scalefac ! An overall scaling factor for the areas and variable. - real :: temp_scale ! A temporary scaling factor. - logical :: global_sum + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSumming ! The mass-weighted integral of the variable in a column [kg a] + real :: scalefac ! An overall scaling factor for the cell mass and variable [a kg A-1 H-1 L-2 ~> kg m-3 or 1] + real :: temp_scale ! A temporary scaling factor [1] or [a A-1 ~> 1] + logical :: global_sum ! If true do the sum globally, but if false only do the sum on the current PE. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -293,16 +350,21 @@ function global_mass_int_EFP(h, G, GV, var, on_PE_only, scale) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: var !< The variable being integrated + optional, intent(in) :: var !< The variable being integrated in + !! arbitrary, possibly rescaled units [A ~> a] logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only done !! on the local PE, but it is still order invariant. - real, optional, intent(in) :: scale !< A rescaling factor for the variable + real, optional, intent(in) :: scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums type(EFP_type) :: global_mass_int_EFP !< The mass-weighted integral of var (or 1) in - !! kg times the units of var + !! kg times the arbitrary units of var [kg a] ! Local variables - real, dimension(SZI_(G), SZJ_(G)) :: tmpForSum - real :: scalefac ! An overall scaling factor for the areas and variable. + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: tmpForSum ! The mass-weighted integral of the variable in a column [kg a] + real :: scalefac ! An overall scaling factor for the cell mass and variable [a kg A-1 H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, isr, ier, jsr, jer is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -333,19 +395,25 @@ end function global_mass_int_EFP !! in a 1-d array using the local indexing. This uses reproducing sums. subroutine global_i_mean(array, i_mean, G, mask, scale, tmp_scale) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged - real, dimension(SZJ_(G)), intent(out) :: i_mean !< Global mean of array along its i-axis + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(SZJ_(G)), intent(out) :: i_mean !< Global mean of array along its i-axis [a] or [A ~> a] real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: mask !< An array used for weighting the i-mean - real, optional, intent(in) :: scale !< A rescaling factor for the output variable + optional, intent(in) :: mask !< An array used for weighting the i-mean [nondim] + real, optional, intent(in) :: scale !< A rescaling factor for the output variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A rescaling factor for the internal - !! calculations that is removed from the output + !! calculations that is removed from the output [a A-1 ~> 1] ! Local variables - type(EFP_type), allocatable, dimension(:) :: asum, mask_sum - real :: scalefac ! A scaling factor for the variable. - real :: unscale ! A factor for undoing any internal rescaling before output. - real :: mask_sum_r + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + type(EFP_type), allocatable, dimension(:) :: asum ! The masked sum of the variable in each row [a] + type(EFP_type), allocatable, dimension(:) :: mask_sum ! The sum of the mask values in each row [nondim] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: unscale ! A factor for undoing any internal rescaling before output [A a-1 ~> 1] + real :: mask_sum_r ! The sum of the mask values in a row [nondim] integer :: is, ie, js, je, idg_off, jdg_off integer :: i, j @@ -367,7 +435,7 @@ subroutine global_i_mean(array, i_mean, G, mask, scale, tmp_scale) asum(j) = real_to_EFP(0.0) ; mask_sum(j) = real_to_EFP(0.0) enddo - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(scalefac*array(i,j)*mask(i,j)) mask_sum(j+jdg_off) = mask_sum(j+jdg_off) + real_to_EFP(mask(i,j)) enddo ; enddo @@ -392,7 +460,7 @@ subroutine global_i_mean(array, i_mean, G, mask, scale, tmp_scale) else do j=G%jsg,G%jeg ; asum(j) = real_to_EFP(0.0) ; enddo - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie asum(j+jdg_off) = asum(j+jdg_off) + real_to_EFP(scalefac*array(i,j)) enddo ; enddo @@ -419,19 +487,25 @@ end subroutine global_i_mean !! in a 1-d array using the local indexing. This uses reproducing sums. subroutine global_j_mean(array, j_mean, G, mask, scale, tmp_scale) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged - real, dimension(SZI_(G)), intent(out) :: j_mean !< Global mean of array along its j-axis + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: array !< The variable being averaged in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(SZI_(G)), intent(out) :: j_mean !< Global mean of array along its j-axis [a] or [A ~> a] real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: mask !< An array used for weighting the j-mean - real, optional, intent(in) :: scale !< A rescaling factor for the output variable + real, optional, intent(in) :: scale !< A rescaling factor for the output variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums real, optional, intent(in) :: tmp_scale !< A rescaling factor for the internal - !! calculations that is removed from the output + !! calculations that is removed from the output [a A-1 ~> 1] ! Local variables - type(EFP_type), allocatable, dimension(:) :: asum, mask_sum - real :: mask_sum_r - real :: scalefac ! A scaling factor for the variable. - real :: unscale ! A factor for undoing any internal rescaling before output. + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + type(EFP_type), allocatable, dimension(:) :: asum ! The masked sum of the variable in each row [a] + type(EFP_type), allocatable, dimension(:) :: mask_sum ! The sum of the mask values in each row [nondim] + real :: mask_sum_r ! The sum of the mask values in a row [nondim] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: unscale ! A factor for undoing any internal rescaling before output [A a-1 ~> 1] integer :: is, ie, js, je, idg_off, jdg_off integer :: i, j @@ -504,16 +578,23 @@ end subroutine global_j_mean !> Adjust 2d array such that area mean is zero without moving the zero contour subroutine adjust_area_mean_to_zero(array, G, scaling, unit_scale) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: array !< 2D array to be adjusted - real, optional, intent(out) :: scaling !< The scaling factor used - real, optional, intent(in) :: unit_scale !< A rescaling factor for the variable + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: array !< 2D array to be adjusted in + !! arbitrary, possibly rescaled units [A ~> a] + real, optional, intent(out) :: scaling !< The scaling factor used [nondim] + real, optional, intent(in) :: unit_scale !< A rescaling factor for the variable [a A-1 ~> 1] + !! that converts it back to unscaled (e.g., mks) + !! units to enable the use of the reproducing sums ! Local variables - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: posVals, negVals, areaXposVals, areaXnegVals + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: posVals, negVals ! The positive or negative values in a cell or 0 [a] + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: areaXposVals, areaXnegVals ! The cell area integral of the values [m2 a] + type(EFP_type), dimension(2) :: areaInt_EFP ! An EFP version integral of the values on the current PE [m2 a] + real :: scalefac ! A scaling factor for the variable [a A-1 ~> 1] + real :: I_scalefac ! The Adcroft reciprocal of scalefac [A a-1 ~> 1] + real :: areaIntPosVals, areaIntNegVals ! The global area integral of the positive and negative values [m2 a] + real :: posScale, negScale ! The scaling factor to apply to positive or negative values [nondim] integer :: i,j - type(EFP_type), dimension(2) :: areaInt_EFP - real :: scalefac ! A scaling factor for the variable. - real :: I_scalefac ! The Adcroft reciprocal of scalefac - real :: areaIntPosVals, areaIntNegVals, posScale, negScale scalefac = 1.0 ; if (present(unit_scale)) scalefac = unit_scale I_scalefac = 0.0 ; if (scalefac /= 0.0) I_scalefac = 1.0 / scalefac diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 4eb1e67e96..fd957d0a44 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -4,6 +4,7 @@ module MOM_sum_output ! This file is part of MOM6. See LICENSE.md for the license. use iso_fortran_env, only : int64 +use MOM_checksums, only : is_NaN use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs @@ -12,8 +13,9 @@ module MOM_sum_output use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_interface_heights, only : find_eta -use MOM_io, only : create_file, file_type, fieldtype, flush_file, reopen_file, close_file -use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field, MOM_write_field +use MOM_io, only : create_MOM_file, reopen_MOM_file +use MOM_io, only : MOM_infra_file, MOM_netcdf_file, MOM_field +use MOM_io, only : file_exists, slasher, vardesc, var_desc, MOM_write_field use MOM_io, only : field_size, read_variable, read_attribute, open_ASCII_file, stdout use MOM_io, only : axis_info, set_axis_info, delete_axis_info, get_filename_appendix use MOM_io, only : attribute_info, set_attribute_info, delete_attribute_info @@ -108,23 +110,25 @@ module MOM_sum_output !! of calls to write_energy and revert to the standard !! energysavedays interval - real :: timeunit !< The length of the units for the time axis [s]. + real :: timeunit !< The length of the units for the time axis and certain input parameters + !! including ENERGYSAVEDAYS [s]. + logical :: date_stamped_output !< If true, use dates (not times) in messages to stdout. type(time_type) :: Start_time !< The start time of the simulation. ! Start_time is set in MOM_initialization.F90 integer, pointer :: ntrunc => NULL() !< The number of times the velocity has been !! truncated since the last call to write_energy. real :: max_Energy !< The maximum permitted energy per unit mass. If there is - !! more energy than this, the model should stop [m2 s-2]. + !! more energy than this, the model should stop [L2 T-2 ~> m2 s-2]. integer :: maxtrunc !< The number of truncations per energy save !! interval at which the run is stopped. logical :: write_stocks !< If true, write the integrated tracer amounts !! to stdout when the energy files are written. integer :: previous_calls = 0 !< The number of times write_energy has been called. integer :: prev_n = 0 !< The value of n from the last call. - type(file_type) :: fileenergy_nc !< The file handle for the netCDF version of the energy file. + type(MOM_netcdf_file) :: fileenergy_nc !< The file handle for the netCDF version of the energy file. integer :: fileenergy_ascii !< The unit number of the ascii version of the energy file. - type(fieldtype), dimension(NUM_FIELDS+MAX_FIELDS_) :: & + type(MOM_field), dimension(NUM_FIELDS+MAX_FIELDS_) :: & fields !< fieldtype variables for the output fields. character(len=200) :: energyfile !< The name of the energy file with path. end type sum_output_CS @@ -147,13 +151,12 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module. ! Local variables - real :: Time_unit ! The time unit in seconds for ENERGYSAVEDAYS [s] - real :: maxvel ! The maximum permitted velocity [m s-1] + real :: maxvel ! The maximum permitted velocity [L T-1 ~> m s-1] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_sum_output" ! This module's name. character(len=200) :: energyfile ! The name of the energy file. - character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs + character(len=32) :: filename_appendix = '' ! FMS appendix to filename for ensemble runs if (associated(CS)) then call MOM_error(WARNING, "MOM_sum_output_init called with associated control structure.") @@ -190,13 +193,14 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & "The maximum permitted average energy per unit mass; the "//& "model will be stopped if there is more energy than "//& "this. If zero or negative, this is set to 10*MAXVEL^2.", & - units="m2 s-2", default=0.0) + units="m2 s-2", default=0.0, scale=US%m_s_to_L_T**2) if (CS%max_Energy <= 0.0) then call get_param(param_file, mdl, "MAXVEL", maxvel, & "The maximum velocity allowed before the velocity "//& - "components are truncated.", units="m s-1", default=3.0e8) + "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) CS%max_Energy = 10.0 * maxvel**2 - call log_param(param_file, mdl, "MAX_ENERGY as used", CS%max_Energy) + call log_param(param_file, mdl, "MAX_ENERGY as used", CS%max_Energy, & + units="m2 s-2", unscale=US%L_T_to_m_s**2) endif call get_param(param_file, mdl, "ENERGYFILE", energyfile, & @@ -218,13 +222,12 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & call get_param(param_file, mdl, "DATE_STAMPED_STDOUT", CS%date_stamped_output, & "If true, use dates (not times) in messages to stdout", & default=.true.) + ! Note that the units of CS%Timeunit are the MKS units of [s]. call get_param(param_file, mdl, "TIMEUNIT", CS%Timeunit, & "The time unit in seconds a number of input fields", & units="s", default=86400.0) if (CS%Timeunit < 0.0) CS%Timeunit = 86400.0 - - if (CS%do_APE_calc) then call get_param(param_file, mdl, "READ_DEPTH_LIST", CS%read_depth_list, & "Read the depth list from a file if it exists or "//& @@ -257,18 +260,15 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & CS%DL%listsize = 1 endif - call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & - "The time unit for ENERGYSAVEDAYS.", & - units="s", default=86400.0) call get_param(param_file, mdl, "ENERGYSAVEDAYS",CS%energysavedays, & "The interval in units of TIMEUNIT between saves of the "//& "energies of the run and other globally summed diagnostics.",& - default=set_time(0,days=1), timeunit=Time_unit) + default=set_time(0,days=1), timeunit=CS%Timeunit) call get_param(param_file, mdl, "ENERGYSAVEDAYS_GEOMETRIC",CS%energysavedays_geometric, & "The starting interval in units of TIMEUNIT for the first call "//& "to save the energies of the run and other globally summed diagnostics. "//& "The interval increases by a factor of 2. after each call to write_energy.",& - default=set_time(seconds=0), timeunit=Time_unit) + default=set_time(seconds=0), timeunit=CS%Timeunit) if ((time_type_to_real(CS%energysavedays_geometric) > 0.) .and. & (CS%energysavedays_geometric < CS%energysavedays)) then @@ -328,7 +328,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci real :: PE_tot ! The total available potential energy [J]. real :: Z_0APE(SZK_(GV)+1) ! The uniform depth which overlies the same ! volume as is below an interface [Z ~> m]. - real :: H_0APE(SZK_(GV)+1) ! A version of Z_0APE, converted to m, usually positive. + real :: H_0APE(SZK_(GV)+1) ! A version of Z_0APE, converted to m, usually positive [m]. real :: toten ! The total kinetic & potential energies of ! all layers [J] (i.e. kg m2 s-2). real :: En_mass ! The total kinetic and potential energies divided by @@ -381,7 +381,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci real :: CFL_lin ! A simpler definition of the CFL number [nondim]. real :: max_CFL(2) ! The maxima of the CFL numbers [nondim]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - tmp1 ! A temporary array + tmp1 ! A temporary array used in reproducing sums [various] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & PE_pt ! The potential energy at each point [J]. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -398,21 +398,26 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci ! lbelow & labove are lower & upper limits for li ! in the search for the entry in lH to use. integer :: start_of_day, num_days - real :: reday, var + real :: reday ! Time in units given by CS%Timeunit, but often [days] character(len=240) :: energypath_nc character(len=200) :: mesg character(len=32) :: mesg_intro, time_units, day_str, n_str, date_str logical :: date_stamped type(time_type) :: dt_force ! A time_type version of the forcing timestep. - real :: Tr_stocks(MAX_FIELDS_) ! The total amounts of each of the registered tracers - real :: Tr_min(MAX_FIELDS_) ! The global minimum unmasked value of the tracers - real :: Tr_max(MAX_FIELDS_) ! The global maximum unmasked value of the tracers + ! The units of the tracer stock vary between tracers, with [conc] given explicitly by Tr_units. + real :: Tr_stocks(MAX_FIELDS_) ! The total amounts of each of the registered tracers [kg conc] + real :: Tr_min(MAX_FIELDS_) ! The global minimum unmasked value of the tracers [conc] + real :: Tr_max(MAX_FIELDS_) ! The global maximum unmasked value of the tracers [conc] real :: Tr_min_x(MAX_FIELDS_) ! The x-positions of the global tracer minima + ! in the units of G%geoLonT, often [degrees_E] or [km] real :: Tr_min_y(MAX_FIELDS_) ! The y-positions of the global tracer minima - real :: Tr_min_z(MAX_FIELDS_) ! The z-positions of the global tracer minima + ! in the units of G%geoLatT, often [degrees_N] or [km] + real :: Tr_min_z(MAX_FIELDS_) ! The z-positions of the global tracer minima [layer] real :: Tr_max_x(MAX_FIELDS_) ! The x-positions of the global tracer maxima + ! in the units of G%geoLonT, often [degrees_E] or [km] real :: Tr_max_y(MAX_FIELDS_) ! The y-positions of the global tracer maxima - real :: Tr_max_z(MAX_FIELDS_) ! The z-positions of the global tracer maxima + ! in the units of G%geoLatT, often [degrees_N] or [km] + real :: Tr_max_z(MAX_FIELDS_) ! The z-positions of the global tracer maxima [layer] logical :: Tr_minmax_avail(MAX_FIELDS_) ! A flag indicating whether the global minimum and ! maximum information are available for each of the tracers character(len=40), dimension(MAX_FIELDS_) :: & @@ -596,17 +601,15 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci endif endif endif - endif - energypath_nc = trim(CS%energyfile) // ".nc" - if (day > CS%Start_time) then - call reopen_file(CS%fileenergy_nc, trim(energypath_nc), vars, & - num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, & - G=G, GV=GV) - else - call create_file(CS%fileenergy_nc, trim(energypath_nc), vars, & - num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, & - G=G, GV=GV) + energypath_nc = trim(CS%energyfile) // ".nc" + if (day > CS%Start_time) then + call reopen_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & + num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) + else + call create_MOM_file(CS%fileenergy_nc, trim(energypath_nc), vars, & + num_nc_fields, CS%fields, SINGLE_FILE, CS%timeunit, G=G, GV=GV) + endif endif endif @@ -792,7 +795,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci date_str = trim(mesg_intro)//trim(day_str) endif - if (is_root_pe()) then + if (is_root_pe()) then ! Only the root PE actually writes anything. if (CS%use_temperature) then write(stdout,'(A," ",A,": En ",ES12.6, ", MaxCFL ", F8.5, ", Mass ", & & ES18.12, ", Salt ", F15.11,", Temp ", F15.11)') & @@ -858,46 +861,44 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci enddo endif - endif - var = real(CS%ntrunc) - call write_field(CS%fileenergy_nc, CS%fields(1), var, reday) - call write_field(CS%fileenergy_nc, CS%fields(2), toten, reday) - call write_field(CS%fileenergy_nc, CS%fields(3), PE, reday) - call write_field(CS%fileenergy_nc, CS%fields(4), KE, reday) - call write_field(CS%fileenergy_nc, CS%fields(5), H_0APE, reday) - call write_field(CS%fileenergy_nc, CS%fields(6), mass_lay, reday) - - call write_field(CS%fileenergy_nc, CS%fields(7), mass_tot, reday) - call write_field(CS%fileenergy_nc, CS%fields(8), mass_chg, reday) - call write_field(CS%fileenergy_nc, CS%fields(9), mass_anom, reday) - call write_field(CS%fileenergy_nc, CS%fields(10), max_CFL(1), reday) - call write_field(CS%fileenergy_nc, CS%fields(11), max_CFL(2), reday) - if (CS%use_temperature) then - call write_field(CS%fileenergy_nc, CS%fields(12), 0.001*Salt, reday) - call write_field(CS%fileenergy_nc, CS%fields(13), 0.001*salt_chg, reday) - call write_field(CS%fileenergy_nc, CS%fields(14), 0.001*salt_anom, reday) - call write_field(CS%fileenergy_nc, CS%fields(15), Heat, reday) - call write_field(CS%fileenergy_nc, CS%fields(16), heat_chg, reday) - call write_field(CS%fileenergy_nc, CS%fields(17), heat_anom, reday) - do m=1,nTr_stocks - call write_field(CS%fileenergy_nc, CS%fields(17+m), Tr_stocks(m), reday) - enddo - else - do m=1,nTr_stocks - call write_field(CS%fileenergy_nc, CS%fields(11+m), Tr_stocks(m), reday) - enddo - endif + call CS%fileenergy_nc%write_field(CS%fields(1), real(CS%ntrunc), reday) + call CS%fileenergy_nc%write_field(CS%fields(2), toten, reday) + call CS%fileenergy_nc%write_field(CS%fields(3), PE, reday) + call CS%fileenergy_nc%write_field(CS%fields(4), KE, reday) + call CS%fileenergy_nc%write_field(CS%fields(5), H_0APE, reday) + call CS%fileenergy_nc%write_field(CS%fields(6), mass_lay, reday) + + call CS%fileenergy_nc%write_field(CS%fields(7), mass_tot, reday) + call CS%fileenergy_nc%write_field(CS%fields(8), mass_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(9), mass_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(10), max_CFL(1), reday) + call CS%fileenergy_nc%write_field(CS%fields(11), max_CFL(2), reday) + if (CS%use_temperature) then + call CS%fileenergy_nc%write_field(CS%fields(12), 0.001*Salt, reday) + call CS%fileenergy_nc%write_field(CS%fields(13), 0.001*salt_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(14), 0.001*salt_anom, reday) + call CS%fileenergy_nc%write_field(CS%fields(15), Heat, reday) + call CS%fileenergy_nc%write_field(CS%fields(16), heat_chg, reday) + call CS%fileenergy_nc%write_field(CS%fields(17), heat_anom, reday) + do m=1,nTr_stocks + call CS%fileenergy_nc%write_field(CS%fields(17+m), Tr_stocks(m), reday) + enddo + else + do m=1,nTr_stocks + call CS%fileenergy_nc%write_field(CS%fields(11+m), Tr_stocks(m), reday) + enddo + endif - call flush_file(CS%fileenergy_nc) + call CS%fileenergy_nc%flush() + endif ! Only the root PE actually writes anything. - ! The second (impossible-looking) test looks for a NaN in En_mass. - if ((En_mass>CS%max_Energy) .or. & - ((En_mass>CS%max_Energy) .and. (En_mass US%L_T_to_m_s**2*CS%max_Energy) then write(mesg,'("Energy per unit mass of ",ES11.4," exceeds ",ES11.4)') & - En_mass, CS%max_Energy - call MOM_error(FATAL, & - "write_energy : Excessive energy per unit mass or NaNs forced model termination.") + En_mass, US%L_T_to_m_s**2*CS%max_Energy + call MOM_error(FATAL, "write_energy : Excessive energy per unit mass forced model termination.") endif if (CS%ntrunc>CS%maxtrunc) then call MOM_error(FATAL, "write_energy : Ocean velocity has been truncated too many times.") @@ -913,7 +914,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci end subroutine write_energy -!> This subroutine accumates the net input of volume, salt and heat, through +!> This subroutine accumulates the net input of volume, salt and heat, through !! the ocean surface for use in diagnosing conservation. subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible @@ -1100,7 +1101,7 @@ end subroutine depth_list_setup subroutine create_depth_list(G, DL, min_depth_inc) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Depth_List), intent(inout) :: DL !< The list of depths, areas and volumes to create - real, intent(in) :: min_depth_inc !< The minimum increment bewteen depths in the list [Z ~> m] + real, intent(in) :: min_depth_inc !< The minimum increment between depths in the list [Z ~> m] ! Local variables real, dimension(G%Domain%niglobal*G%Domain%njglobal + 1) :: & @@ -1110,7 +1111,7 @@ subroutine create_depth_list(G, DL, min_depth_inc) indx2 !< The position of an element in the original unsorted list. real :: Dnow !< The depth now being considered for sorting [Z ~> m]. real :: Dprev !< The most recent depth that was considered [Z ~> m]. - real :: vol !< The running sum of open volume below a deptn [Z L2 ~> m3]. + real :: vol !< The running sum of open volume below a depth [Z L2 ~> m3]. real :: area !< The open area at the current depth [L2 ~> m2]. real :: D_list_prev !< The most recent depth added to the list [Z ~> m]. logical :: add_to_list !< This depth should be included as an entry on the list. @@ -1232,13 +1233,13 @@ subroutine write_depth_list(G, US, DL, filename) ! Local variables type(vardesc), dimension(:), allocatable :: & vars ! Types that described the staggering and metadata for the fields - type(fieldtype), dimension(:), allocatable :: & + type(MOM_field), dimension(:), allocatable :: & fields ! Types with metadata about the variables that will be written type(axis_info), dimension(:), allocatable :: & extra_axes ! Descriptors for extra axes that might be used type(attribute_info), dimension(:), allocatable :: & global_atts ! Global attributes and their values - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_netcdf_file) :: IO_handle ! The I/O handle of the fileset character(len=16) :: depth_chksum, area_chksum ! All ranks are required to compute the global checksum @@ -1258,8 +1259,8 @@ subroutine write_depth_list(G, US, DL, filename) call set_attribute_info(global_atts(1), depth_chksum_attr, depth_chksum) call set_attribute_info(global_atts(2), area_chksum_attr, area_chksum) - call create_file(IO_handle, filename, vars, 3, fields, SINGLE_FILE, extra_axes=extra_axes, & - global_atts=global_atts) + call create_MOM_file(IO_handle, filename, vars, 3, fields, SINGLE_FILE, & + extra_axes=extra_axes, global_atts=global_atts) call MOM_write_field(IO_handle, fields(1), DL%depth, scale=US%Z_to_m) call MOM_write_field(IO_handle, fields(2), DL%area, scale=US%L_to_m**2) call MOM_write_field(IO_handle, fields(3), DL%vol_below, scale=US%Z_to_m*US%L_to_m**2) @@ -1267,8 +1268,7 @@ subroutine write_depth_list(G, US, DL, filename) call delete_axis_info(extra_axes) call delete_attribute_info(global_atts) deallocate(vars, extra_axes, fields, global_atts) - call close_file(IO_handle) - + call IO_handle%close() end subroutine write_depth_list !> This subroutine reads in the depth list from the specified file @@ -1360,7 +1360,7 @@ subroutine get_depth_list_checksums(G, US, depth_chksum, area_chksum) character(len=16), intent(out) :: area_chksum !< Area checksum hexstring integer :: i, j - real, allocatable :: field(:,:) + real, allocatable :: field(:,:) ! A temporary array for output converted to MKS units [m] or [m2] allocate(field(G%isc:G%iec, G%jsc:G%jec)) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 85f27d4249..9c8cd099f3 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -35,7 +35,7 @@ module MOM_wave_speed !! internal wave speed. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as !! monotonic for the purposes of calculating the equivalent barotropic - !! wave speed. This parameter controls the default behavior of + !! wave speed [nondim]. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed [Z ~> m]. @@ -44,13 +44,17 @@ module MOM_wave_speed real :: min_speed2 = 0. !< The minimum mode 1 internal wave speed squared [L2 T-2 ~> m2 s-2] real :: wave_speed_tol = 0.001 !< The fractional tolerance with which to solve for the wave !! speeds [nondim] + real :: c1_thresh = -1.0 !< A minimal value of the first mode internal wave speed + !! below which all higher mode speeds are not calculated but + !! are simply reported as 0 [L T-1 ~> m s-1]. A non-negative + !! value must be specified via a call to wave_speed_init for + !! the subroutine wave_speeds to be used (but not wave_speed). type(remapping_CS) :: remapping_CS !< Used for vertical remapping when calculating equivalent barotropic !! mode structure. - integer :: remap_answer_date = 20181231 !< The vintage of the order of arithmetic and expressions to use + integer :: remap_answer_date = 99991231 !< The vintage of the order of arithmetic and expressions to use !! for remapping. Values below 20190101 recover the remapping !! answers from 2018, while higher values use more robust !! forms of the same remapping expressions. - !### Change to 99991231? type(diag_ctrl), pointer :: diag !< Diagnostics control structure end type wave_speed_CS @@ -73,7 +77,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction !! of water column over which N2 is limited as monotonic - !! for the purposes of calculating vertical modal structure. + !! for the purposes of calculating vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical !! modal structure [Z ~> m]. @@ -105,11 +109,14 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] - real :: det, ddet + real :: det, ddet ! Determinant of the eigen system and its derivative with lam. Because the + ! units of the eigenvalue change with the number of layers and because of the + ! dynamic rescaling that is used to keep det in a numerically representable range, + ! the units of of det are hard to interpret, but det/ddet is always in units + ! of [T2 L-2 ~> s2 m-2] real :: lam ! The eigenvalue [T2 L-2 ~> s2 m-2] real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] real :: lam0 ! The first guess of the eigenvalue [T2 L-2 ~> s2 m-2] - real :: min_h_frac ! [nondim] real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] real, dimension(SZI_(G)) :: & htot, hmin, & ! Thicknesses [Z ~> m] @@ -121,43 +128,51 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real :: L2_to_Z2 ! A scaling factor squared from units of lateral distances to depths [Z2 L-2 ~> 1]. real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. - real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant - ! and its derivative with lam between rows of the Thomas algorithm solver. The - ! exact value should not matter for the final result if it is an even power of 2. + real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and + ! its derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. + ! The exact value should not matter for the final result if it is an even power of 2. real :: tol_Hfrac ! Layers that together are smaller than this fraction of - ! the total water column can be merged for efficiency. + ! the total water column can be merged for efficiency [nondim]. + real :: min_h_frac ! tol_Hfrac divided by the total number of layers [nondim]. real :: tol_solve ! The fractional tolerance with which to solve for the wave speeds [nondim] real :: tol_merge ! The fractional change in estimated wave speed that is allowed ! when deciding to merge layers in the calculation [nondim] - real :: rescale, I_rescale + real :: rescale ! A rescaling factor to control the magnitude of the determinant [nondim] + real :: I_rescale ! The reciprocal of the rescaling factor to control the magnitude of the determinant [nondim] integer :: kf(SZI_(G)) ! The number of active layers after filtering. integer, parameter :: max_itt = 10 - real :: lam_it(max_itt), det_it(max_itt), ddet_it(max_itt) + real :: lam_it(max_itt) ! The guess at the eignevalue with each iteration [T2 L-2 ~> s2 m-2] + real :: det_it(max_itt), ddet_it(max_itt) ! The determinant of the matrix and its derivative with lam + ! with each iteration. Because of all of the dynamic rescaling of the determinant + ! between rows, its units are not easily interpretable, but the ratio of det/ddet + ! always has units of [T2 L-2 ~> s2 m-2] logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. logical :: better_est ! If true, use an improved estimate of the first mode internal wave speed. logical :: merge ! If true, merge the current layer with the one above. integer :: kc ! The number of layers in the column after merging integer :: i, j, k, k2, itt, is, ie, js, je, nz - real :: hw, sum_hc + real :: hw ! The mean of the adjacent layer thicknesses [Z ~> m] + real :: sum_hc ! The sum of the layer thicknesses [Z ~> m] real :: gp ! A limited local copy of gprime [L2 Z-1 T-2 ~> m s-2] - real :: N2min ! A minimum buoyancy frequency [T-2 ~> s-2] + real :: N2min ! A minimum buoyancy frequency, including a slope rescaling factor [L2 Z-2 T-2 ~> s-2] logical :: l_use_ebt_mode, calc_modal_structure - real :: l_mono_N2_column_fraction, l_mono_N2_depth - real :: mode_struct(SZK_(GV)), ms_min, ms_max, ms_sq + real :: l_mono_N2_column_fraction ! A local value of mono_N2_column_fraction [nondim] + real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [Z ~> m] + real :: mode_struct(SZK_(GV)) ! The mode structure [nondim], but it is also temporarily + ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6. + real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2] + real :: ms_sq ! The sum of the square of the values returned from tdma6 [L4 T-4 ~> m4 s-4] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed / wave_speed: "// & "Module must be initialized before it is used.") if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed endif ; endif - L2_to_Z2 = US%L_to_Z**2 - l_use_ebt_mode = CS%use_ebt_mode if (present(use_ebt_mode)) l_use_ebt_mode = use_ebt_mode l_mono_N2_column_fraction = CS%mono_N2_column_fraction @@ -201,7 +216,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,tv,& !$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & !$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale,L2_to_Z2, & +!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale, & !$OMP better_est,cg1_min2,tol_merge,tol_solve,c2_scale) & !$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & !$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT,drho_dS, & @@ -435,7 +450,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ if (l_use_ebt_mode) then Igu(1) = 0. ! Neumann condition for pressure modes sum_hc = Hc(1) - N2min = L2_to_Z2*gprime(2)/Hc(1) + N2min = gprime(2)/Hc(1) do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) @@ -443,12 +458,12 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !### 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 + (gp > N2min*hw) ) then ! Filters out regions where N2 increases with depth but only in a lower fraction ! of the water column or below a certain depth. - gp = US%Z_to_L**2 * (N2min*hw) + gp = N2min * hw else - N2min = L2_to_Z2 * gp/hw + N2min = gp / hw endif endif Igu(k) = 1.0/(gp*Hc(k)) @@ -526,6 +541,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ if (calc_modal_structure) then call tdma6(kc, Igu, Igl, lam, mode_struct) + ! Note that tdma6 changes the units of mode_struct to [L2 T-2 ~> m2 s-2] ms_min = mode_struct(1) ms_max = mode_struct(1) ms_sq = mode_struct(1)**2 @@ -541,6 +557,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ else mode_struct(1:kc) = mode_struct(1:kc) / sqrt( ms_sq ) endif + ! After the nondimensionalization above, mode_struct is once again [nondim] endif if (abs(dlam) < tol_solve*lam) exit @@ -591,13 +608,13 @@ subroutine tdma6(n, a, c, lam, y) real, dimension(:), intent(in) :: a !< Lower diagonal [T2 L-2 ~> s2 m-2] real, dimension(:), intent(in) :: c !< Upper diagonal [T2 L-2 ~> s2 m-2] real, intent(in) :: lam !< Scalar subtracted from leading diagonal [T2 L-2 ~> s2 m-2] - real, dimension(:), intent(inout) :: y !< RHS on entry, result on exit + real, dimension(:), intent(inout) :: y !< RHS on entry [A ~> a], result on exit [A L2 T-2 ~> a m2 s-2] ! Local variables real :: lambda ! A temporary variable in [T2 L-2 ~> s2 m-2] real :: beta(n) ! A temporary variable in [T2 L-2 ~> s2 m-2] real :: I_beta(n) ! A temporary variable in [L2 T-2 ~> m2 s-2] - real :: yy(n) ! A temporary variable with the same units as y on entry. + real :: yy(n) ! A temporary variable with the same units as y on entry [A ~> a] integer :: k, m lambda = lam @@ -635,16 +652,16 @@ end subroutine tdma6 !> Calculates the wave speeds for the first few barolinic modes. subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables integer, intent(in) :: nmodes !< Number of modes real, dimension(G%isd:G%ied,G%jsd:G%jed,nmodes), intent(out) :: cn !< Waves speeds [L T-1 ~> m s-1] - type(wave_speed_CS), optional, intent(in) :: CS !< Wave speed control struct + type(wave_speed_CS), intent(in) :: CS !< Wave speed control struct logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational domain. + !! over the entire data domain. ! Local variables real, dimension(SZK_(GV)+1) :: & @@ -669,25 +686,34 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt] Rc ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] - real :: c1_thresh ! if c1 is below this value, don't bother calculating - ! cn values for higher modes [L T-1 ~> m s-1] - real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant - ! and its derivative with lam between rows of the Thomas algorithm solver. The - ! exact value should not matter for the final result if it is an even power of 2. - real :: det, ddet ! determinant & its derivative of eigen system + real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and its + ! derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. + ! The exact value should not matter for the final result if it is an even power of 2. + real :: det, ddet ! Determinant of the eigen system and its derivative with lam. Because the + ! units of the eigenvalue change with the number of layers and because of the + ! dynamic rescaling that is used to keep det in a numerically representable range, + ! the units of of det are hard to interpret, but det/ddet is always in units + ! of [T2 L-2 ~> s2 m-2] real :: lam_1 ! approximate mode-1 eigenvalue [T2 L-2 ~> s2 m-2] real :: lam_n ! approximate mode-n eigenvalue [T2 L-2 ~> s2 m-2] real :: dlam ! The change in estimates of the eigenvalue [T2 L-2 ~> s2 m-2] real :: lamMin ! minimum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamMax ! maximum lam value for root searching range [T2 L-2 ~> s2 m-2] real :: lamInc ! width of moving window for root searching [T2 L-2 ~> s2 m-2] - real :: det_l,det_r ! determinant value at left and right of window - real :: ddet_l,ddet_r ! derivative of determinant at left and right of window - real :: det_sub,ddet_sub! derivative of determinant at subinterval endpoint - real :: xl,xr ! lam guesses at left and right of window [T2 L-2 ~> s2 m-2] + real :: det_l, ddet_l ! determinant of the eigensystem and its derivative with lam at the lower + ! end of the range of values bracketing a particular root, in dynamically + ! rescaled units that may differ from the other det variables, but such + ! that the units of det_l/ddet_l are [T2 L-2 ~> s2 m-2] + real :: det_r, ddet_r ! determinant and its derivative with lam at the lower end of the + ! bracket in arbitrarily rescaled units, but such that the units of + ! det_r/ddet_r are [T2 L-2 ~> s2 m-2] + real :: det_sub, ddet_sub ! determinant and its derivative with lam at a subinterval endpoint that + ! is a candidate for a new bracket endpoint in arbitrarily rescaled units, + ! but such that the units of det_sub/ddet_sub are [T2 L-2 ~> s2 m-2] + real :: xl, xr ! lam guesses at left and right of window [T2 L-2 ~> s2 m-2] real :: xl_sub ! lam guess at left of subinterval window [T2 L-2 ~> s2 m-2] - real,dimension(nmodes) :: & - xbl,xbr ! lam guesses bracketing a zero-crossing (root) [T2 L-2 ~> s2 m-2] + real, dimension(nmodes) :: & + xbl, xbr ! lam guesses bracketing a zero-crossing (root) [T2 L-2 ~> s2 m-2] integer :: numint ! number of widows (intervals) in root searching range integer :: nrootsfound ! number of extra roots found (not including 1st root) real :: Z_to_pres ! A conversion factor from thicknesses to pressure [R L2 T-2 Z-1 ~> Pa m-1] @@ -699,14 +725,13 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) HxR_here ! A layer integrated density [R Z ~> kg m-2] real :: speed2_tot ! overestimate of the mode-1 speed squared [L2 T-2 ~> m2 s-2] real :: speed2_min ! minimum mode speed (squared) to consider in root searching [L2 T-2 ~> m2 s-2] - real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] - real, parameter :: reduct_factor = 0.5 - ! A factor used in setting speed2_min [nondim] - real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] - real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. + real :: cg1_min2 ! A floor in the squared first mode speed below which 0 is returned [L2 T-2 ~> m2 s-2] + real, parameter :: reduct_factor = 0.5 ! A factor used in setting speed2_min [nondim] + real :: I_Hnew ! The inverse of a new layer thickness [Z-1 ~> m-1] + real :: drxh_sum ! The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] + real :: g_Rho0 ! G_Earth/Rho0 [L2 T-2 Z-1 R-1 ~> m4 s-2 kg-1]. real :: tol_Hfrac ! Layers that together are smaller than this fraction of - ! the total water column can be merged for efficiency. + ! the total water column can be merged for efficiency [nondim]. real :: min_h_frac ! tol_Hfrac divided by the total number of layers [nondim]. real :: tol_solve ! The fractional tolerance with which to solve for the wave speeds [nondim]. real :: tol_merge ! The fractional change in estimated wave speed that is allowed @@ -727,10 +752,8 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - if (present(CS)) then - if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed: "// & - "Module must be initialized before it is used.") - endif + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_wave_speed / wave_speeds: "// & + "Module must be initialized before it is used.") if (present(full_halos)) then ; if (full_halos) then is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed @@ -740,26 +763,28 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) use_EOS = associated(tv%eqn_of_state) - c1_thresh = 0.01*US%m_s_to_L_T + if (CS%c1_thresh < 0.0) & + call MOM_error(FATAL, "INTERNAL_WAVE_CG1_THRESH must be set to a non-negative "//& + "value via wave_speed_init for wave_speeds to be used.") c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. - better_est = .false. ; if (present(CS)) better_est = CS%better_cg1_est + better_est = CS%better_cg1_est if (better_est) then - tol_solve = 0.001 ; if (present(CS)) tol_solve = CS%wave_speed_tol + tol_solve = CS%wave_speed_tol tol_Hfrac = 0.1*tol_solve ; tol_merge = tol_solve / real(nz) else tol_solve = 0.001 ; tol_Hfrac = 0.0001 ; tol_merge = 0.001 endif - cg1_min2 = 0.0 ; if (present(CS)) cg1_min2 = CS%min_speed2 + cg1_min2 = CS%min_speed2 ! Zero out all wave speeds. Values over land or for columns that are too weakly stratified ! are not changed from this zero value. cn(:,:,:) = 0.0 min_h_frac = tol_Hfrac / real(nz) - !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS, & + !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,CS,min_h_frac,use_EOS, & !$OMP Z_to_pres,tv,cn,g_Rho0,nmodes,cg1_min2,better_est, & - !$OMP c1_thresh,tol_solve,tol_merge,c2_scale) + !$OMP tol_solve,tol_merge,c2_scale) do j=js,je ! First merge very thin layers with the one above (or below if they are ! at the top). This also transposes the row order so that columns can @@ -1021,7 +1046,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, full_halos) ! Find other eigen values if c1 is of significant magnitude, > cn_thresh nrootsfound = 0 ! number of extra roots found (not including 1st root) - if (nmodes>1 .and. kc>=nmodes+1 .and. cn(i,j,1)>c1_thresh) then + if ((nmodes > 1) .and. (kc >= nmodes+1) .and. (cn(i,j,1) > CS%c1_thresh)) then ! Set the the range to look for the other desired eigen values ! set min value just greater than the 1st root (found above) lamMin = lam_1*(1.0 + tol_solve) @@ -1128,20 +1153,27 @@ end subroutine wave_speeds !! signs are typically used, so internal rescaling by consistent factors are used to avoid !! over- or underflow. subroutine tridiag_det(a, c, ks, ke, lam, det, ddet, row_scale) - real, dimension(:), intent(in) :: a !< Lower diagonal of matrix (first entry unused) - real, dimension(:), intent(in) :: c !< Upper diagonal of matrix (last entry unused) + real, dimension(:), intent(in) :: a !< Lower diagonal of matrix (first entry unused) [T2 L-2 ~> s2 m-2] + real, dimension(:), intent(in) :: c !< Upper diagonal of matrix (last entry unused) [T2 L-2 ~> s2 m-2] integer, intent(in) :: ks !< Starting index to use in determinant integer, intent(in) :: ke !< Ending index to use in determinant - real, intent(in) :: lam !< Value subtracted from b - real, intent(out):: det !< Determinant - real, intent(out):: ddet !< Derivative of determinant with lam - real, intent(in) :: row_scale !< A scaling factor of the rows of the - !! matrix to limit the growth of the determinant + real, intent(in) :: lam !< Value subtracted from b [T2 L-2 ~> s2 m-2] + real, intent(out):: det !< Determinant of the matrix in dynamically rescaled units that + !! depend on the number of rows and the cumulative magnitude of + !! det and are therefore difficult to interpret, but the units + !! of det/ddet are always in [T2 L-2 ~> s2 m-2] + real, intent(out):: ddet !< Derivative of determinant with lam in units that are dynamically + !! rescaled along with those of det, such that the units of + !! det/ddet are always in [T2 L-2 ~> s2 m-2] + real, intent(in) :: row_scale !< A scaling factor of the rows of the matrix to + !! limit the growth of the determinant [L2 s2 T-2 m-2 ~> 1] ! Local variables - real :: detKm1, detKm2 ! Cumulative value of the determinant for the previous two layers. - real :: ddetKm1, ddetKm2 ! Derivative of the cumulative determinant with lam for the previous two layers. - real, parameter :: rescale = 1024.0**4 ! max value of determinant allowed before rescaling - real :: I_rescale ! inverse of rescale + real :: detKm1, detKm2 ! Cumulative value of the determinant for the previous two layers in units + ! that vary with the number of layers that have been worked on [various] + real :: ddetKm1, ddetKm2 ! Derivative of the cumulative determinant with lam for the previous two + ! layers [various], but the units of detKm1/ddetKm1 are [T2 L-2 ~> s2 m-2] + real, parameter :: rescale = 1024.0**4 ! max value of determinant allowed before rescaling [nondim] + real :: I_rescale ! inverse of rescale [nondim] integer :: k ! row (layer interface) index I_rescale = 1.0 / rescale @@ -1170,13 +1202,13 @@ end subroutine tridiag_det !> Initialize control structure for MOM_wave_speed subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & - remap_answer_date, better_speed_est, min_speed, wave_speed_tol) + remap_answer_date, better_speed_est, min_speed, wave_speed_tol, c1_thresh) type(wave_speed_CS), intent(inout) :: CS !< Wave speed control struct logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over !! which N2 is limited as monotonic for the purposes of - !! calculating the vertical modal structure. + !! calculating the vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited !! as monotonic for the purposes of calculating the !! vertical modal structure [Z ~> m]. @@ -1193,6 +1225,10 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de !! below which 0 is returned [L T-1 ~> m s-1]. real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] + real, optional, intent(in) :: c1_thresh !< A minimal value of the first mode internal wave speed + !! below which all higher mode speeds are not calculated but are + !! simply reported as 0 [L T-1 ~> m s-1]. A non-negative value + !! must be specified for wave_speeds to be used (but not wave_speed). ! This include declares and sets the variable "version". # include "version_variable.h" @@ -1204,10 +1240,11 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de call log_version(mdl, version) call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction, & - better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol) - !### Uncomment this? remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date) + better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol, & + remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date, & + c1_thresh=c1_thresh) - !### The remap_answers_2018 argument is irrelevant, because remapping is hard-coded to use PLM. + ! The remap_answers_2018 argument here is irrelevant, because remapping is hard-coded to use PLM. call initialize_remapping(CS%remapping_CS, 'PLM', boundary_extrapolation=.false., & answer_date=CS%remap_answer_date) @@ -1215,14 +1252,14 @@ end subroutine wave_speed_init !> Sets internal parameters for MOM_wave_speed subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_depth, remap_answers_2018, & - remap_answer_date, better_speed_est, min_speed, wave_speed_tol) + remap_answer_date, better_speed_est, min_speed, wave_speed_tol, c1_thresh) type(wave_speed_CS), intent(inout) :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over !! which N2 is limited as monotonic for the purposes of - !! calculating the vertical modal structure. + !! calculating the vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited !! as monotonic for the purposes of calculating the !! vertical modal structure [Z ~> m]. @@ -1239,6 +1276,10 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ !! below which 0 is returned [L T-1 ~> m s-1]. real, optional, intent(in) :: wave_speed_tol !< The fractional tolerance for finding the !! wave speeds [nondim] + real, optional, intent(in) :: c1_thresh !< A minimal value of the first mode internal wave speed + !! below which all higher mode speeds are not calculated but are + !! simply reported as 0 [L T-1 ~> m s-1]. A non-negative value + !! must be specified for wave_speeds to be used (but not wave_speed). if (present(use_ebt_mode)) CS%use_ebt_mode = use_ebt_mode if (present(mono_N2_column_fraction)) CS%mono_N2_column_fraction = mono_N2_column_fraction @@ -1254,6 +1295,7 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ if (present(better_speed_est)) CS%better_cg1_est = better_speed_est if (present(min_speed)) CS%min_speed2 = min_speed**2 if (present(wave_speed_tol)) CS%wave_speed_tol = wave_speed_tol + if (present(c1_thresh)) CS%c1_thresh = c1_thresh end subroutine wave_speed_set_param diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 0f97b560db..80d23eeb75 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -57,10 +57,9 @@ module MOM_wave_structure !< Squared buoyancy frequency at each interface [T-2 ~> s-2]. integer, allocatable, dimension(:,:):: num_intfaces !< Number of layer interfaces (including surface and bottom) [nondim]. - real :: int_tide_source_x !< X Location of generation site - !! for internal tide for testing (BDM) - real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) + ! logical :: int_tide_source_test !< If true, apply an arbitrary generation site for internal tide testing + ! integer :: int_tide_source_i !< I Location of generation site + ! integer :: int_tide_source_j !< J Location of generation site logical :: debug !< debugging prints end type wave_structure_CS @@ -143,7 +142,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo HxR_here !< A layer integrated density [R Z ~> kg m-2] real :: I_Hnew !< The inverse of a new layer thickness [Z-1 ~> m-1] real :: drxh_sum !< The sum of density differences across interfaces times thicknesses [R Z ~> kg m-2] - real, parameter :: tol1 = 0.0001, tol2 = 0.001 + real, parameter :: tol1 = 0.0001, tol2 = 0.001 ! Nondimensional tolerances [nondim] real :: g_Rho0 !< G_Earth/Rho0 in [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]. ! real :: rescale, I_rescale integer :: kf(SZI_(G)) @@ -281,7 +280,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo do i=is,ie ; if (cn(i,j) > 0.0) then !----for debugging, remove later---- ig = i + G%idg_offset ; jg = j + G%jdg_offset - !if (ig == CS%int_tide_source_x .and. jg == CS%int_tide_source_y) then + !if (ig == CS%int_tide_source_i .and. jg == CS%int_tide_source_j) then !----------------------------------- if (G%mask2dT(i,j) > 0.0) then @@ -762,10 +761,15 @@ subroutine wave_structure_init(Time, G, GV, param_file, diag, CS) CS%initialized = .true. - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) + ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + ! "If true, apply an arbitrary generation site for internal tide testing", & + ! default=.false.) + ! if (CS%int_tide_source_test) then + ! call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_I", CS%int_tide_source_i, & + ! "I Location of generation site for internal tide", default=0) + ! 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) + ! endif call get_param(param_file, mdl, "DEBUG", CS%debug, & "debugging prints", default=.false.) diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index c946ddaff8..4ddedf85a8 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -126,16 +126,18 @@ module MOM_EOS real :: dTFr_dp !< The derivative of freezing point with pressure [degC Pa-1] ! Unit conversion factors (normally used for dimensional testing but could also allow for -! change of units of arguments to functions) - real :: m_to_Z = 1. !< A constant that translates distances in meters to the units of depth. - real :: kg_m3_to_R = 1. !< A constant that translates kilograms per meter cubed to the units of density. - real :: R_to_kg_m3 = 1. !< A constant that translates the units of density to kilograms per meter cubed. - real :: RL2_T2_to_Pa = 1.!< Convert pressures from R L2 T-2 to Pa. - real :: L_T_to_m_s = 1. !< Convert lateral velocities from L T-1 to m s-1. - real :: degC_to_C = 1. !< A constant that translates degrees Celsius to the units of temperature. - real :: C_to_degC = 1. !< A constant that translates the units of temperature to degrees Celsius. - real :: ppt_to_S = 1. !< A constant that translates parts per thousand to the units of salinity. - real :: S_to_ppt = 1. !< A constant that translates the units of salinity to parts per thousand. +! change of units of arguments to functions + real :: m_to_Z = 1. !< A constant that translates distances in meters to the units of depth [Z m-1 ~> 1] + real :: kg_m3_to_R = 1. !< A constant that translates kilograms per meter cubed to the + !! units of density [R m3 kg-1 ~> 1] + real :: R_to_kg_m3 = 1. !< A constant that translates the units of density to + !! kilograms per meter cubed [kg m-3 R-1 ~> 1] + real :: RL2_T2_to_Pa = 1.!< Convert pressures from R L2 T-2 to Pa [Pa T2 R-1 L-2 ~> 1] + real :: L_T_to_m_s = 1. !< Convert lateral velocities from L T-1 to m s-1 [m T s-1 L-1 ~> 1] + real :: degC_to_C = 1. !< A constant that translates degrees Celsius to the units of temperature [C degC-1 ~> 1] + real :: C_to_degC = 1. !< A constant that translates the units of temperature to degrees Celsius [degC C-1 ~> 1] + real :: ppt_to_S = 1. !< A constant that translates parts per thousand to the units of salinity [S ppt-1 ~> 1] + real :: S_to_ppt = 1. !< A constant that translates the units of salinity to parts per thousand [ppt S-1 ~> 1] ! logical :: test_EOS = .true. ! If true, test the equation of state end type EOS_type @@ -219,7 +221,11 @@ subroutine calculate_stanley_density_scalar(T, S, pressure, Tvar, TScov, Svar, r real, optional, intent(in) :: scale !< A multiplicative factor by which to scale output density in !! combination with scaling stored in EOS [various] ! Local variables - real :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p + real :: d2RdTT ! Second derivative of density with temperature [kg m-3 degC-2] + real :: d2RdST ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] + real :: d2RdSS ! Second derivative of density with salinity [kg m-3 ppt-2] + real :: d2RdSp ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] + real :: d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: T_scale ! A factor to convert temperature to units of degC [degC C-1 ~> 1] real :: S_scale ! A factor to convert salinity to units of ppt [ppt S-1 ~> 1] @@ -309,7 +315,12 @@ subroutine calculate_stanley_density_array(T, S, pressure, Tvar, TScov, Svar, rh real, optional, intent(in) :: scale !< A multiplicative factor by which to scale the output !! density, perhaps to other units than kg m-3 [various] ! Local variables - real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p + real, dimension(size(T)) :: & + d2RdTT, & ! Second derivative of density with temperature [kg m-3 degC-2] + d2RdST, & ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] + d2RdSS, & ! Second derivative of density with salinity [kg m-3 ppt-2] + d2RdSp, & ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] + d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] integer :: j select case (EOS%form_of_EOS) @@ -417,13 +428,18 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho, real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] real :: T2_scale ! A factor to convert temperature variance to units of degC2 [degC2 C-2 ~> 1] real :: S2_scale ! A factor to convert salinity variance to units of ppt2 [ppt2 S-2 ~> 1] - real :: TS_scale ! A factor to convert temperture-salinity covariance to units of + real :: TS_scale ! A factor to convert temperature-salinity covariance to units of ! degC ppt [degC ppt C-1 S-1 ~> 1] real :: rho_reference ! rho_ref converted to [kg m-3] real, dimension(size(rho)) :: pres ! Pressure converted to [Pa] real, dimension(size(rho)) :: Ta ! Temperature converted to [degC] real, dimension(size(rho)) :: Sa ! Salinity converted to [ppt] - real, dimension(size(T)) :: d2RdTT, d2RdST, d2RdSS, d2RdSp, d2RdTp ! Second derivatives of density wrt T,S,p + real, dimension(size(T)) :: & + d2RdTT, & ! Second derivative of density with temperature [kg m-3 degC-2] + d2RdST, & ! Second derivative of density with temperature and salinity [kg m-3 degC-1 ppt-1] + d2RdSS, & ! Second derivative of density with salinity [kg m-3 ppt-2] + d2RdSp, & ! Second derivative of density with salinity and pressure [kg m-3 ppt-1 Pa-1] + d2RdTp ! Second derivative of density with temperature and pressure [kg m-3 degC-1 Pa-1] integer :: i, is, ie, npts if (present(dom)) then @@ -616,11 +632,11 @@ end subroutine calc_spec_vol_1d !> Calls the appropriate subroutine to calculate the freezing point for scalar inputs. subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS, pres_scale, scale_from_EOS) - real, intent(in) :: S !< Salinity, [ppt] or [Z ~> ppt] depending on scale_from_EOS + real, intent(in) :: S !< Salinity, [ppt] or [S ~> ppt] depending on scale_from_EOS real, intent(in) :: pressure !< Pressure, in [Pa] or [R L2 T-2 ~> Pa] depending on !! pres_scale or scale_from_EOS real, intent(out) :: T_fr !< Freezing point potential temperature referenced to the - !! surface [degC] or [degC ~> C] depending on scale_from_EOS + !! surface [degC] or [C ~> degC] depending on scale_from_EOS type(EOS_type), intent(in) :: EOS !< Equation of state structure real, optional, intent(in) :: pres_scale !< A multiplicative factor to convert pressure !! into Pa [Pa T2 R-1 L-2 ~> 1]. @@ -670,7 +686,7 @@ subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS, pres_sca ! Local variables real, dimension(size(pressure)) :: pres ! Pressure converted to [Pa] - real :: p_scale ! A factor to convert pressure to units of Pa. + real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] integer :: j p_scale = 1.0 ; if (present(pres_scale)) p_scale = pres_scale @@ -1007,7 +1023,7 @@ subroutine calculate_density_second_derivs_1d(T, S, pressure, drho_dS_dS, drho_d end subroutine calculate_density_second_derivs_1d -!> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. +!> Calls the appropriate subroutine to calculate density second derivatives for scalar inputs. subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & drho_dS_dP, drho_dT_dP, EOS, scale) real, intent(in) :: T !< Potential temperature referenced to the surface [C ~> degC] @@ -1028,7 +1044,6 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr !! in combination with scaling stored in EOS [various] ! Local variables real :: rho_scale ! A factor to convert density from kg m-3 to the desired units [R m3 kg-1 ~> 1] - real :: p_scale ! A factor to convert pressure to units of Pa [Pa T2 R-1 L-2 ~> 1] real :: pres ! Pressure converted to [Pa] real :: Ta ! Temperature converted to [degC] real :: Sa ! Salinity converted to [ppt] @@ -1061,9 +1076,9 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr drho_dT_dP = rho_scale * drho_dT_dP endif - if (p_scale /= 1.0) then - drho_dS_dP = p_scale * drho_dS_dP - drho_dT_dP = p_scale * drho_dT_dP + if (EOS%RL2_T2_to_Pa /= 1.0) then + drho_dS_dP = EOS%RL2_T2_to_Pa * drho_dS_dP + drho_dT_dP = EOS%RL2_T2_to_Pa * drho_dT_dP endif if (EOS%C_to_degC /= 1.0) then @@ -1173,7 +1188,7 @@ subroutine calc_spec_vol_derivs_1d(T, S, pressure, dSV_dT, dSV_dS, EOS, dom, sca if (present(scale)) spv_scale = spv_scale * scale dSVdT_scale = spv_scale * EOS%C_to_degC dSVdS_scale = spv_scale * EOS%S_to_ppt - if (spv_scale /= 1.0) then ; do i=is,ie + if ((dSVdT_scale /= 1.0) .or. (dSVdS_scale /= 1.0)) then ; do i=is,ie dSV_dT(i) = dSVdT_scale * dSV_dT(i) dSV_dS(i) = dSVdS_scale * dSV_dS(i) enddo ; endif @@ -1251,8 +1266,13 @@ subroutine calculate_compress_scalar(T, S, pressure, rho, drho_dp, EOS) type(EOS_type), intent(in) :: EOS !< Equation of state structure ! Local variables - ! These arrays use the same units as their counterparts in calcluate_compress_1d. - real, dimension(1) :: Ta, Sa, pa, rhoa, drho_dpa + ! These arrays use the same units as their counterparts in calculate_compress_1d. + real, dimension(1) :: pa ! Pressure in a size-1 1d array [R L2 T-2 ~> Pa] + real, dimension(1) :: Ta ! Temperature in a size-1 1d array [C ~> degC] + real, dimension(1) :: Sa ! Salinity in a size-1 1d array [S ~> ppt] + real, dimension(1) :: rhoa ! In situ density in a size-1 1d array [R ~> kg m-3] + real, dimension(1) :: drho_dpa ! The partial derivative of density with pressure (also the + ! inverse of the square of sound speed) in a 1d array [T2 L-2 ~> s2 m-2] Ta(1) = T ; Sa(1) = S ; pa(1) = pressure @@ -1629,11 +1649,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & intent(inout) :: S !< Salinity [S ~> ppt] real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed,kd), & - intent(in) :: mask_z !< 3d mask regulating which points to convert. + intent(in) :: mask_z !< 3d mask regulating which points to convert [nondim] type(EOS_type), intent(in) :: EOS !< Equation of state structure + real :: gsw_sr_from_sp ! Reference salinity after conversion from practical salinity [ppt] + real :: gsw_ct_from_pt ! Conservative temperature after conversion from potential temperature [degC] integer :: i, j, k - real :: gsw_sr_from_sp, gsw_ct_from_pt if ((EOS%form_of_EOS /= EOS_TEOS10) .and. (EOS%form_of_EOS /= EOS_NEMO)) return @@ -1713,7 +1734,7 @@ subroutine abs_saln_to_prac_saln(S, prSaln, EOS, dom, scale) ! Local variables real, dimension(size(S)) :: Sa ! Salinity converted to [ppt] - real :: S_scale ! A factor to convert practical salnity from ppt to the desired units [S ppt-1 ~> 1] + real :: S_scale ! A factor to convert practical salinity from ppt to the desired units [S ppt-1 ~> 1] integer :: i, is, ie if (present(dom)) then diff --git a/src/equation_of_state/MOM_EOS_NEMO.F90 b/src/equation_of_state/MOM_EOS_NEMO.F90 index 476fda6b70..dee2bc48bf 100644 --- a/src/equation_of_state/MOM_EOS_NEMO.F90 +++ b/src/equation_of_state/MOM_EOS_NEMO.F90 @@ -22,8 +22,8 @@ module MOM_EOS_NEMO public calculate_density_derivs_nemo public calculate_density_scalar_nemo, calculate_density_array_nemo -!> Compute the in situ density of sea water ([kg m-3]), or its anomaly with respect to -!! a reference density, from absolute salinity (g/kg), conservative temperature (in deg C), +!> Compute the in situ density of sea water [kg m-3], or its anomaly with respect to +!! a reference density, from absolute salinity [g kg-1], conservative temperature [degC], !! and pressure [Pa], using the expressions derived for use with NEMO interface calculate_density_nemo module procedure calculate_density_scalar_nemo, calculate_density_array_nemo @@ -35,140 +35,145 @@ module MOM_EOS_NEMO module procedure calculate_density_derivs_scalar_nemo, calculate_density_derivs_array_nemo end interface calculate_density_derivs_nemo -real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar +real, parameter :: Pa2db = 1.e-4 !< Conversion factor between Pa and dbar [Pa dbar-1] !>@{ Parameters in the NEMO equation of state -real, parameter :: rdeltaS = 32. -real, parameter :: r1_S0 = 0.875/35.16504 -real, parameter :: r1_T0 = 1./40. -real, parameter :: r1_P0 = 1.e-4 -real, parameter :: R00 = 4.6494977072e+01 -real, parameter :: R01 = -5.2099962525 -real, parameter :: R02 = 2.2601900708e-01 -real, parameter :: R03 = 6.4326772569e-02 -real, parameter :: R04 = 1.5616995503e-02 -real, parameter :: R05 = -1.7243708991e-03 -real, parameter :: EOS000 = 8.0189615746e+02 -real, parameter :: EOS100 = 8.6672408165e+02 -real, parameter :: EOS200 = -1.7864682637e+03 -real, parameter :: EOS300 = 2.0375295546e+03 -real, parameter :: EOS400 = -1.2849161071e+03 -real, parameter :: EOS500 = 4.3227585684e+02 -real, parameter :: EOS600 = -6.0579916612e+01 -real, parameter :: EOS010 = 2.6010145068e+01 -real, parameter :: EOS110 = -6.5281885265e+01 -real, parameter :: EOS210 = 8.1770425108e+01 -real, parameter :: EOS310 = -5.6888046321e+01 -real, parameter :: EOS410 = 1.7681814114e+01 -real, parameter :: EOS510 = -1.9193502195 -real, parameter :: EOS020 = -3.7074170417e+01 -real, parameter :: EOS120 = 6.1548258127e+01 -real, parameter :: EOS220 = -6.0362551501e+01 -real, parameter :: EOS320 = 2.9130021253e+01 -real, parameter :: EOS420 = -5.4723692739 -real, parameter :: EOS030 = 2.1661789529e+01 -real, parameter :: EOS130 = -3.3449108469e+01 -real, parameter :: EOS230 = 1.9717078466e+01 -real, parameter :: EOS330 = -3.1742946532 -real, parameter :: EOS040 = -8.3627885467 -real, parameter :: EOS140 = 1.1311538584e+01 -real, parameter :: EOS240 = -5.3563304045 -real, parameter :: EOS050 = 5.4048723791e-01 -real, parameter :: EOS150 = 4.8169980163e-01 -real, parameter :: EOS060 = -1.9083568888e-01 -real, parameter :: EOS001 = 1.9681925209e+01 -real, parameter :: EOS101 = -4.2549998214e+01 -real, parameter :: EOS201 = 5.0774768218e+01 -real, parameter :: EOS301 = -3.0938076334e+01 -real, parameter :: EOS401 = 6.6051753097 -real, parameter :: EOS011 = -1.3336301113e+01 -real, parameter :: EOS111 = -4.4870114575 -real, parameter :: EOS211 = 5.0042598061 -real, parameter :: EOS311 = -6.5399043664e-01 -real, parameter :: EOS021 = 6.7080479603 -real, parameter :: EOS121 = 3.5063081279 -real, parameter :: EOS221 = -1.8795372996 -real, parameter :: EOS031 = -2.4649669534 -real, parameter :: EOS131 = -5.5077101279e-01 -real, parameter :: EOS041 = 5.5927935970e-01 -real, parameter :: EOS002 = 2.0660924175 -real, parameter :: EOS102 = -4.9527603989 -real, parameter :: EOS202 = 2.5019633244 -real, parameter :: EOS012 = 2.0564311499 -real, parameter :: EOS112 = -2.1311365518e-01 -real, parameter :: EOS022 = -1.2419983026 -real, parameter :: EOS003 = -2.3342758797e-02 -real, parameter :: EOS103 = -1.8507636718e-02 -real, parameter :: EOS013 = 3.7969820455e-01 -real, parameter :: ALP000 = -6.5025362670e-01 -real, parameter :: ALP100 = 1.6320471316 -real, parameter :: ALP200 = -2.0442606277 -real, parameter :: ALP300 = 1.4222011580 -real, parameter :: ALP400 = -4.4204535284e-01 -real, parameter :: ALP500 = 4.7983755487e-02 -real, parameter :: ALP010 = 1.8537085209 -real, parameter :: ALP110 = -3.0774129064 -real, parameter :: ALP210 = 3.0181275751 -real, parameter :: ALP310 = -1.4565010626 -real, parameter :: ALP410 = 2.7361846370e-01 -real, parameter :: ALP020 = -1.6246342147 -real, parameter :: ALP120 = 2.5086831352 -real, parameter :: ALP220 = -1.4787808849 -real, parameter :: ALP320 = 2.3807209899e-01 -real, parameter :: ALP030 = 8.3627885467e-01 -real, parameter :: ALP130 = -1.1311538584 -real, parameter :: ALP230 = 5.3563304045e-01 -real, parameter :: ALP040 = -6.7560904739e-02 -real, parameter :: ALP140 = -6.0212475204e-02 -real, parameter :: ALP050 = 2.8625353333e-02 -real, parameter :: ALP001 = 3.3340752782e-01 -real, parameter :: ALP101 = 1.1217528644e-01 -real, parameter :: ALP201 = -1.2510649515e-01 -real, parameter :: ALP301 = 1.6349760916e-02 -real, parameter :: ALP011 = -3.3540239802e-01 -real, parameter :: ALP111 = -1.7531540640e-01 -real, parameter :: ALP211 = 9.3976864981e-02 -real, parameter :: ALP021 = 1.8487252150e-01 -real, parameter :: ALP121 = 4.1307825959e-02 -real, parameter :: ALP031 = -5.5927935970e-02 -real, parameter :: ALP002 = -5.1410778748e-02 -real, parameter :: ALP102 = 5.3278413794e-03 -real, parameter :: ALP012 = 6.2099915132e-02 -real, parameter :: ALP003 = -9.4924551138e-03 -real, parameter :: BET000 = 1.0783203594e+01 -real, parameter :: BET100 = -4.4452095908e+01 -real, parameter :: BET200 = 7.6048755820e+01 -real, parameter :: BET300 = -6.3944280668e+01 -real, parameter :: BET400 = 2.6890441098e+01 -real, parameter :: BET500 = -4.5221697773 -real, parameter :: BET010 = -8.1219372432e-01 -real, parameter :: BET110 = 2.0346663041 -real, parameter :: BET210 = -2.1232895170 -real, parameter :: BET310 = 8.7994140485e-01 -real, parameter :: BET410 = -1.1939638360e-01 -real, parameter :: BET020 = 7.6574242289e-01 -real, parameter :: BET120 = -1.5019813020 -real, parameter :: BET220 = 1.0872489522 -real, parameter :: BET320 = -2.7233429080e-01 -real, parameter :: BET030 = -4.1615152308e-01 -real, parameter :: BET130 = 4.9061350869e-01 -real, parameter :: BET230 = -1.1847737788e-01 -real, parameter :: BET040 = 1.4073062708e-01 -real, parameter :: BET140 = -1.3327978879e-01 -real, parameter :: BET050 = 5.9929880134e-03 -real, parameter :: BET001 = -5.2937873009e-01 -real, parameter :: BET101 = 1.2634116779 -real, parameter :: BET201 = -1.1547328025 -real, parameter :: BET301 = 3.2870876279e-01 -real, parameter :: BET011 = -5.5824407214e-02 -real, parameter :: BET111 = 1.2451933313e-01 -real, parameter :: BET211 = -2.4409539932e-02 -real, parameter :: BET021 = 4.3623149752e-02 -real, parameter :: BET121 = -4.6767901790e-02 -real, parameter :: BET031 = -6.8523260060e-03 -real, parameter :: BET002 = -6.1618945251e-02 -real, parameter :: BET102 = 6.2255521644e-02 -real, parameter :: BET012 = -2.6514181169e-03 -real, parameter :: BET003 = -2.3025968587e-04 +real, parameter :: rdeltaS = 32. ! An offset to salinity before taking its square root [g kg-1] +real, parameter :: r1_S0 = 0.875/35.16504 ! The inverse of a plausible range of oceanic salinities [kg g-1] +real, parameter :: r1_T0 = 1./40. ! The inverse of a plausible range of oceanic temperatures [degC-1] +real, parameter :: r1_P0 = 1.e-4 ! The inverse of a plausible range of oceanic pressures [dbar-1] +real, parameter :: R00 = 4.6494977072e+01 ! Contribution to zr0 proportional to zp [kg m-3] +real, parameter :: R01 = -5.2099962525 ! Contribution to zr0 proportional to zp**2 [kg m-3] +real, parameter :: R02 = 2.2601900708e-01 ! Contribution to zr0 proportional to zp**3 [kg m-3] +real, parameter :: R03 = 6.4326772569e-02 ! Contribution to zr0 proportional to zp**4 [kg m-3] +real, parameter :: R04 = 1.5616995503e-02 ! Contribution to zr0 proportional to zp**5 [kg m-3] +real, parameter :: R05 = -1.7243708991e-03 ! Contribution to zr0 proportional to zp**6 [kg m-3] + +! The following terms are contributions to density as a function of the normalized square root of salinity +! with an offset (zs), temperature (zt) and pressure, with a contribution EOSabc * zs**a * zt**b * zp**c +real, parameter :: EOS000 = 8.0189615746e+02 ! A constant density contribution [kg m-3] +real, parameter :: EOS100 = 8.6672408165e+02 ! Coefficient of the EOS proportional to zs [kg m-3] +real, parameter :: EOS200 = -1.7864682637e+03 ! Coefficient of the EOS proportional to zs**2 [kg m-3] +real, parameter :: EOS300 = 2.0375295546e+03 ! Coefficient of the EOS proportional to zs**3 [kg m-3] +real, parameter :: EOS400 = -1.2849161071e+03 ! Coefficient of the EOS proportional to zs**4 [kg m-3] +real, parameter :: EOS500 = 4.3227585684e+02 ! Coefficient of the EOS proportional to zs**5 [kg m-3] +real, parameter :: EOS600 = -6.0579916612e+01 ! Coefficient of the EOS proportional to zs**6 [kg m-3] +real, parameter :: EOS010 = 2.6010145068e+01 ! Coefficient of the EOS proportional to zt [kg m-3] +real, parameter :: EOS110 = -6.5281885265e+01 ! Coefficient of the EOS proportional to zs * zt [kg m-3] +real, parameter :: EOS210 = 8.1770425108e+01 ! Coefficient of the EOS proportional to zs**2 * zt [kg m-3] +real, parameter :: EOS310 = -5.6888046321e+01 ! Coefficient of the EOS proportional to zs**3 * zt [kg m-3] +real, parameter :: EOS410 = 1.7681814114e+01 ! Coefficient of the EOS proportional to zs**2 * zt [kg m-3] +real, parameter :: EOS510 = -1.9193502195 ! Coefficient of the EOS proportional to zs**5 * zt [kg m-3] +real, parameter :: EOS020 = -3.7074170417e+01 ! Coefficient of the EOS proportional to zt**2 [kg m-3] +real, parameter :: EOS120 = 6.1548258127e+01 ! Coefficient of the EOS proportional to zs * zt**2 [kg m-3] +real, parameter :: EOS220 = -6.0362551501e+01 ! Coefficient of the EOS proportional to zs**2 * zt**2 [kg m-3] +real, parameter :: EOS320 = 2.9130021253e+01 ! Coefficient of the EOS proportional to s**3 * zt**2 [kg m-3] +real, parameter :: EOS420 = -5.4723692739 ! Coefficient of the EOS proportional to zs**4 * zt**2 [kg m-3] +real, parameter :: EOS030 = 2.1661789529e+01 ! Coefficient of the EOS proportional to zt**3 [kg m-3] +real, parameter :: EOS130 = -3.3449108469e+01 ! Coefficient of the EOS proportional to zs * zt**3 [kg m-3] +real, parameter :: EOS230 = 1.9717078466e+01 ! Coefficient of the EOS proportional to zs**2 * zt**3 [kg m-3] +real, parameter :: EOS330 = -3.1742946532 ! Coefficient of the EOS proportional to zs**3 * zt**3 [kg m-3] +real, parameter :: EOS040 = -8.3627885467 ! Coefficient of the EOS proportional to zt**4 [kg m-3] +real, parameter :: EOS140 = 1.1311538584e+01 ! Coefficient of the EOS proportional to zs * zt**4 [kg m-3] +real, parameter :: EOS240 = -5.3563304045 ! Coefficient of the EOS proportional to zs**2 * zt**4 [kg m-3] +real, parameter :: EOS050 = 5.4048723791e-01 ! Coefficient of the EOS proportional to zt**5 [kg m-3] +real, parameter :: EOS150 = 4.8169980163e-01 ! Coefficient of the EOS proportional to zs * zt**5 [kg m-3] +real, parameter :: EOS060 = -1.9083568888e-01 ! Coefficient of the EOS proportional to zt**6 [kg m-3] +real, parameter :: EOS001 = 1.9681925209e+01 ! Coefficient of the EOS proportional to zp [kg m-3] +real, parameter :: EOS101 = -4.2549998214e+01 ! Coefficient of the EOS proportional to zs * zp [kg m-3] +real, parameter :: EOS201 = 5.0774768218e+01 ! Coefficient of the EOS proportional to zs**2 * zp [kg m-3] +real, parameter :: EOS301 = -3.0938076334e+01 ! Coefficient of the EOS proportional to zs**3 * zp [kg m-3] +real, parameter :: EOS401 = 6.6051753097 ! Coefficient of the EOS proportional to zs**4 * zp [kg m-3] +real, parameter :: EOS011 = -1.3336301113e+01 ! Coefficient of the EOS proportional to zt * zp [kg m-3] +real, parameter :: EOS111 = -4.4870114575 ! Coefficient of the EOS proportional to zs * zt * zp [kg m-3] +real, parameter :: EOS211 = 5.0042598061 ! Coefficient of the EOS proportional to zs**2 * zt * zp [kg m-3] +real, parameter :: EOS311 = -6.5399043664e-01 ! Coefficient of the EOS proportional to zs**3 * zt * zp [kg m-3] +real, parameter :: EOS021 = 6.7080479603 ! Coefficient of the EOS proportional to zt**2 * zp [kg m-3] +real, parameter :: EOS121 = 3.5063081279 ! Coefficient of the EOS proportional to zs * zt**2 * zp [kg m-3] +real, parameter :: EOS221 = -1.8795372996 ! Coefficient of the EOS proportional to zs**2 * zt**2 * zp [kg m-3] +real, parameter :: EOS031 = -2.4649669534 ! Coefficient of the EOS proportional to zt**3 * zp [kg m-3] +real, parameter :: EOS131 = -5.5077101279e-01 ! Coefficient of the EOS proportional to zs * zt**3 * zp [kg m-3] +real, parameter :: EOS041 = 5.5927935970e-01 ! Coefficient of the EOS proportional to zt**4 * zp [kg m-3] +real, parameter :: EOS002 = 2.0660924175 ! Coefficient of the EOS proportional to zp**2 [kg m-3] +real, parameter :: EOS102 = -4.9527603989 ! Coefficient of the EOS proportional to zs * zp**2 [kg m-3] +real, parameter :: EOS202 = 2.5019633244 ! Coefficient of the EOS proportional to zs**2 * zp**2 [kg m-3] +real, parameter :: EOS012 = 2.0564311499 ! Coefficient of the EOS proportional to zt * zp**2 [kg m-3] +real, parameter :: EOS112 = -2.1311365518e-01 ! Coefficient of the EOS proportional to zs * zt * zp**2 [kg m-3] +real, parameter :: EOS022 = -1.2419983026 ! Coefficient of the EOS proportional to zt**2 * zp**2 [kg m-3] +real, parameter :: EOS003 = -2.3342758797e-02 ! Coefficient of the EOS proportional to zp**3 [kg m-3] +real, parameter :: EOS103 = -1.8507636718e-02 ! Coefficient of the EOS proportional to zs * zp**3 [kg m-3] +real, parameter :: EOS013 = 3.7969820455e-01 ! Coefficient of the EOS proportional to zt * zp**3 [kg m-3] + +real, parameter :: ALP000 = -6.5025362670e-01 ! Constant in the drho_dT fit [kg m-3 degC-1] +real, parameter :: ALP100 = 1.6320471316 ! Coefficient of the drho_dT fit zs term [kg m-3 degC-1] +real, parameter :: ALP200 = -2.0442606277 ! Coefficient of the drho_dT fit zs**2 term [kg m-3 degC-1] +real, parameter :: ALP300 = 1.4222011580 ! Coefficient of the drho_dT fit zs**3 term [kg m-3 degC-1] +real, parameter :: ALP400 = -4.4204535284e-01 ! Coefficient of the drho_dT fit zs**4 term [kg m-3 degC-1] +real, parameter :: ALP500 = 4.7983755487e-02 ! Coefficient of the drho_dT fit zs**5 term [kg m-3 degC-1] +real, parameter :: ALP010 = 1.8537085209 ! Coefficient of the drho_dT fit zt term [kg m-3 degC-1] +real, parameter :: ALP110 = -3.0774129064 ! Coefficient of the drho_dT fit zs * zt term [kg m-3 degC-1] +real, parameter :: ALP210 = 3.0181275751 ! Coefficient of the drho_dT fit zs**2 * zt term [kg m-3 degC-1] +real, parameter :: ALP310 = -1.4565010626 ! Coefficient of the drho_dT fit zs**3 * zt term [kg m-3 degC-1] +real, parameter :: ALP410 = 2.7361846370e-01 ! Coefficient of the drho_dT fit zs**4 * zt term [kg m-3 degC-1] +real, parameter :: ALP020 = -1.6246342147 ! Coefficient of the drho_dT fit zt**2 term [kg m-3 degC-1] +real, parameter :: ALP120 = 2.5086831352 ! Coefficient of the drho_dT fit zs * zt**2 term [kg m-3 degC-1] +real, parameter :: ALP220 = -1.4787808849 ! Coefficient of the drho_dT fit zs**2 * zt**2 term [kg m-3 degC-1] +real, parameter :: ALP320 = 2.3807209899e-01 ! Coefficient of the drho_dT fit zs**3 * zt**2 term [kg m-3 degC-1] +real, parameter :: ALP030 = 8.3627885467e-01 ! Coefficient of the drho_dT fit zt**3 term [kg m-3 degC-1] +real, parameter :: ALP130 = -1.1311538584 ! Coefficient of the drho_dT fit zs * zt**3 term [kg m-3 degC-1] +real, parameter :: ALP230 = 5.3563304045e-01 ! Coefficient of the drho_dT fit zs**2 * zt**3 term [kg m-3 degC-1] +real, parameter :: ALP040 = -6.7560904739e-02 ! Coefficient of the drho_dT fit zt**4 term [kg m-3 degC-1] +real, parameter :: ALP140 = -6.0212475204e-02 ! Coefficient of the drho_dT fit zs* * zt**4 term [kg m-3 degC-1] +real, parameter :: ALP050 = 2.8625353333e-02 ! Coefficient of the drho_dT fit zt**5 term [kg m-3 degC-1] +real, parameter :: ALP001 = 3.3340752782e-01 ! Coefficient of the drho_dT fit zp term [kg m-3 degC-1] +real, parameter :: ALP101 = 1.1217528644e-01 ! Coefficient of the drho_dT fit zs * zp term [kg m-3 degC-1] +real, parameter :: ALP201 = -1.2510649515e-01 ! Coefficient of the drho_dT fit zs**2 * zp term [kg m-3 degC-1] +real, parameter :: ALP301 = 1.6349760916e-02 ! Coefficient of the drho_dT fit zs**3 * zp term [kg m-3 degC-1] +real, parameter :: ALP011 = -3.3540239802e-01 ! Coefficient of the drho_dT fit zt * zp term [kg m-3 degC-1] +real, parameter :: ALP111 = -1.7531540640e-01 ! Coefficient of the drho_dT fit zs * zt * zp term [kg m-3 degC-1] +real, parameter :: ALP211 = 9.3976864981e-02 ! Coefficient of the drho_dT fit zs**2 * zt * zp term [kg m-3 degC-1] +real, parameter :: ALP021 = 1.8487252150e-01 ! Coefficient of the drho_dT fit zt**2 * zp term [kg m-3 degC-1] +real, parameter :: ALP121 = 4.1307825959e-02 ! Coefficient of the drho_dT fit zs * zt**2 * zp term [kg m-3 degC-1] +real, parameter :: ALP031 = -5.5927935970e-02 ! Coefficient of the drho_dT fit zt**3 * zp term [kg m-3 degC-1] +real, parameter :: ALP002 = -5.1410778748e-02 ! Coefficient of the drho_dT fit zp**2 term [kg m-3 degC-1] +real, parameter :: ALP102 = 5.3278413794e-03 ! Coefficient of the drho_dT fit zs * zp**2 term [kg m-3 degC-1] +real, parameter :: ALP012 = 6.2099915132e-02 ! Coefficient of the drho_dT fit zt * zp**2 term [kg m-3 degC-1] +real, parameter :: ALP003 = -9.4924551138e-03 ! Coefficient of the drho_dT fit zp**3 term [kg m-3 degC-1] + +real, parameter :: BET000 = 1.0783203594e+01 ! Constant in the drho_dS fit [kg m-3 ppt-1] +real, parameter :: BET100 = -4.4452095908e+01 ! Coefficient of the drho_dS fit zs term [kg m-3 ppt-1] +real, parameter :: BET200 = 7.6048755820e+01 ! Coefficient of the drho_dS fit zs**2 term [kg m-3 ppt-1] +real, parameter :: BET300 = -6.3944280668e+01 ! Coefficient of the drho_dS fit zs**3 term [kg m-3 ppt-1] +real, parameter :: BET400 = 2.6890441098e+01 ! Coefficient of the drho_dS fit zs**4 term [kg m-3 ppt-1] +real, parameter :: BET500 = -4.5221697773 ! Coefficient of the drho_dS fit zs**5 term [kg m-3 ppt-1] +real, parameter :: BET010 = -8.1219372432e-01 ! Coefficient of the drho_dS fit zt term [kg m-3 ppt-1] +real, parameter :: BET110 = 2.0346663041 ! Coefficient of the drho_dS fit zs * zt term [kg m-3 ppt-1] +real, parameter :: BET210 = -2.1232895170 ! Coefficient of the drho_dS fit zs**2 * zt term [kg m-3 ppt-1] +real, parameter :: BET310 = 8.7994140485e-01 ! Coefficient of the drho_dS fit zs**3 * zt term [kg m-3 ppt-1] +real, parameter :: BET410 = -1.1939638360e-01 ! Coefficient of the drho_dS fit zs**4 * zt term [kg m-3 ppt-1] +real, parameter :: BET020 = 7.6574242289e-01 ! Coefficient of the drho_dS fit zt**2 term [kg m-3 ppt-1] +real, parameter :: BET120 = -1.5019813020 ! Coefficient of the drho_dS fit zs * zt**2 term [kg m-3 ppt-1] +real, parameter :: BET220 = 1.0872489522 ! Coefficient of the drho_dS fit zs**2 * zt**2 term [kg m-3 ppt-1] +real, parameter :: BET320 = -2.7233429080e-01 ! Coefficient of the drho_dS fit zs**3 * zt**2 term [kg m-3 ppt-1] +real, parameter :: BET030 = -4.1615152308e-01 ! Coefficient of the drho_dS fit zt**3 term [kg m-3 ppt-1] +real, parameter :: BET130 = 4.9061350869e-01 ! Coefficient of the drho_dS fit zs * zt**3 term [kg m-3 ppt-1] +real, parameter :: BET230 = -1.1847737788e-01 ! Coefficient of the drho_dS fit zs**2 * zt**3 term [kg m-3 ppt-1] +real, parameter :: BET040 = 1.4073062708e-01 ! Coefficient of the drho_dS fit zt**4 term [kg m-3 ppt-1] +real, parameter :: BET140 = -1.3327978879e-01 ! Coefficient of the drho_dS fit zs * zt**4 term [kg m-3 ppt-1] +real, parameter :: BET050 = 5.9929880134e-03 ! Coefficient of the drho_dS fit zt**5 term [kg m-3 ppt-1] +real, parameter :: BET001 = -5.2937873009e-01 ! Coefficient of the drho_dS fit zp term [kg m-3 ppt-1] +real, parameter :: BET101 = 1.2634116779 ! Coefficient of the drho_dS fit zs * zp term [kg m-3 ppt-1] +real, parameter :: BET201 = -1.1547328025 ! Coefficient of the drho_dS fit zs**2 * zp term [kg m-3 ppt-1] +real, parameter :: BET301 = 3.2870876279e-01 ! Coefficient of the drho_dS fit zs**3 * zp term [kg m-3 ppt-1] +real, parameter :: BET011 = -5.5824407214e-02 ! Coefficient of the drho_dS fit zt * zp term [kg m-3 ppt-1] +real, parameter :: BET111 = 1.2451933313e-01 ! Coefficient of the drho_dS fit zs * zt * zp term [kg m-3 ppt-1] +real, parameter :: BET211 = -2.4409539932e-02 ! Coefficient of the drho_dS fit zs**2 * zt * zp term [kg m-3 ppt-1] +real, parameter :: BET021 = 4.3623149752e-02 ! Coefficient of the drho_dS fit zt**2 * zp term [kg m-3 ppt-1] +real, parameter :: BET121 = -4.6767901790e-02 ! Coefficient of the drho_dS fit zs * zt**2 * zp term [kg m-3 ppt-1] +real, parameter :: BET031 = -6.8523260060e-03 ! Coefficient of the drho_dS fit zt**3 * zp term [kg m-3 ppt-1] +real, parameter :: BET002 = -6.1618945251e-02 ! Coefficient of the drho_dS fit zp**2 term [kg m-3 ppt-1] +real, parameter :: BET102 = 6.2255521644e-02 ! Coefficient of the drho_dS fit zs * zp**2 term [kg m-3 ppt-1] +real, parameter :: BET012 = -2.6514181169e-03 ! Coefficient of the drho_dS fit zt * zp**2 term [kg m-3 ppt-1] +real, parameter :: BET003 = -2.3025968587e-04 ! Coefficient of the drho_dS fit zp**3 term [kg m-3 ppt-1] !>@} contains @@ -184,8 +189,10 @@ subroutine calculate_density_scalar_nemo(T, S, pressure, rho, rho_ref) real, intent(out) :: rho !< In situ density [kg m-3]. real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] T0(1) = T S0(1) = S @@ -210,20 +217,31 @@ subroutine calculate_density_array_nemo(T, S, pressure, rho, start, npts, rho_re real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: zp, zt, zs, zr0, zn, zn0, zn1, zn2, zn3, zs0 + real :: zp ! Pressure, first in [dbar], then normalized by an assumed pressure range [nondim] + real :: zt ! Conservative temperature, first in [degC], then normalized by an assumed temperature range [nondim] + real :: zs ! Absolute salinity, first in [g kg-1], then the square root of salinity with an offset normalized + ! by an assumed salnity range [nondim] + real :: zr0 ! A pressure-dependent but temperature and salinity independent contribution to + ! density at the reference temperature and salinity [kg m-3] + real :: zn ! Density without a pressure-dependent contribution [kg m-3] + real :: zn0 ! A contribution to density from temperature and salinity anomalies at the surface pressure [kg m-3] + real :: zn1 ! A temperature and salinity dependent density contribution proportional to pressure [kg m-3] + real :: zn2 ! A temperature and salinity dependent density contribution proportional to pressure^2 [kg m-3] + real :: zn3 ! A temperature and salinity dependent density contribution proportional to pressure^3 [kg m-3] + real :: zs0 ! Salinity dependent density at the surface pressure and temperature [kg m-3] integer :: j do j=start,start+npts-1 - !Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp - zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar + ! Conversions + zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] !The following algorithm was provided by Roquet in a private communication. !It is not necessarily the algorithm used in NEMO ocean! - zp = zp * r1_P0 !pressure - zt = zt * r1_T0 !temperature - zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root salinity + zp = zp * r1_P0 ! pressure normalized by a plausible range of pressure in the ocean [nondim] + zt = zt * r1_T0 ! temperature normalized by a plausible oceanic range [nondim] + zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] zn3 = EOS013*zt & & + EOS103*zs+EOS003 @@ -274,20 +292,33 @@ subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zp, zt, zs, zn, zn0, zn1, zn2, zn3 + real :: zp ! Pressure, first in [dbar], then normalized by an assumed pressure range [nondim] + real :: zt ! Conservative temperature, first in [degC], then normalized by an assumed temperature range [nondim] + real :: zs ! Absolute salinity, first in [g kg-1], then the square root of salinity with an offset normalized + ! by an assumed salnity range [nondim] + real :: zn ! Partial derivative of density with temperature [kg m-3 degC-1] or salinity [kg m-3 ppt-1] + ! without a pressure-dependent contribution + real :: zn0 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] from temperature anomalies at the surface pressure + real :: zn1 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] proportional to pressure + real :: zn2 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] proportional to pressure^2 + real :: zn3 ! A contribution to the partial derivative of density with temperature [kg m-3 degC-1] or + ! salinity [kg m-3 ppt-1] proportional to pressure^3 integer :: j do j=start,start+npts-1 - !Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp - zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar + ! Conversions + zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] !The following algorithm was provided by Roquet in a private communication. !It is not necessarily the algorithm used in NEMO ocean! - zp = zp * r1_P0 ! pressure (first converted to decibar) - zt = zt * r1_T0 ! temperature - zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root salinity + zp = zp * r1_P0 ! pressure normalized by a plausible range of pressure in the ocean [nondim] + zt = zt * r1_T0 ! temperature normalized by a plausible oceanic range [nondim] + zs = SQRT( ABS( zs + rdeltaS ) * r1_S0 ) ! square root of normalized salinity plus an offset [nondim] ! ! alpha zn3 = ALP003 @@ -329,7 +360,8 @@ subroutine calculate_density_derivs_array_nemo(T, S, pressure, drho_dT, drho_dS, & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 ! zn = ( ( zn3 * zp + zn2 ) * zp + zn1 ) * zp + zn0 - ! + + ! The division by zs here is because zs = sqrt(S + S0), so drho_dS = dzs_dS * drho_dzs = (0.5 / zs) * drho_dzs drho_dS(j) = zn / zs enddo @@ -345,8 +377,13 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds real, intent(out) :: drho_dS !< The partial derivative of density with salinity, !! in [kg m-3 ppt-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: drdt0, drds0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! A 1-d array with a copy of the derivative of density + ! with potential temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! A 1-d array with a copy of the derivative of density + ! with salinity [kg m-3 ppt-1] T0(1) = T S0(1) = S @@ -358,12 +395,12 @@ subroutine calculate_density_derivs_scalar_nemo(T, S, pressure, drho_dt, drho_ds end subroutine calculate_density_derivs_scalar_nemo !> Compute the in situ density of sea water (rho in [kg m-3]) and the compressibility -!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity -!! (sal in g/kg), conservative temperature (T [degC]), and pressure [Pa], using the expressions +!! (drho/dp = C_sound^-2, stored as drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), +!! conservative temperature (T [degC]), and pressure [Pa], using the expressions !! derived for use with NEMO. subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Conservative temperature [degC]. - real, intent(in), dimension(:) :: S !< Absolute salinity [g/kg]. + real, intent(in), dimension(:) :: S !< Absolute salinity [g kg-1]. real, intent(in), dimension(:) :: pressure !< pressure [Pa]. real, intent(out), dimension(:) :: rho !< In situ density [kg m-3]. real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure @@ -373,7 +410,9 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs,zt,zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j call calculate_density_array_nemo(T, S, pressure, rho, start, npts) @@ -382,10 +421,10 @@ subroutine calculate_compress_nemo(T, S, pressure, rho, drho_dp, start, npts) ! since the corresponding NEMO approximation is not available yet. ! do j=start,start+npts-1 - !Conversions - zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp - zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar + ! Conversions + zs = S(j) !gsw_sr_from_sp(S(j)) ! Convert practical salinity to absolute salinity [g kg--1] + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) ! Convert potential temp to conservative temp [degC] + zp = pressure(j) * Pa2db ! Convert pressure from Pascals to decibars [dbar] call gsw_rho_first_derivatives(zs,zt,zp, drho_dp=drho_dp(j)) enddo end subroutine calculate_compress_nemo diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index bbe9982b6f..4c7483c068 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -48,14 +48,13 @@ module MOM_EOS_TEOS10 module procedure calculate_density_second_derivs_scalar_teos10, calculate_density_second_derivs_array_teos10 end interface calculate_density_second_derivs_teos10 -real, parameter :: Pa2db = 1.e-4 !< The conversion factor from Pa to dbar. +real, parameter :: Pa2db = 1.e-4 !< The conversion factor from Pa to dbar [dbar Pa-1] contains -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure [Pa]. It uses the expression from the -!! TEOS10 website. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from absolute salinity (S [g kg-1]), conservative temperature (T [degC]), +!! and pressure [Pa]. It uses the expression from the TEOS10 website. subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Conservative temperature [degC]. real, intent(in) :: S !< Absolute salinity [g kg-1]. @@ -64,8 +63,10 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] T0(1) = T S0(1) = S @@ -76,9 +77,9 @@ subroutine calculate_density_scalar_teos10(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_teos10 -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from absolute salinity (S [g kg-1]), conservative temperature -!! (T [degC]), and pressure [Pa]. It uses the expression from the +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from absolute salinity (S [g kg-1]), conservative temperature (T [degC]), +!! and pressure [Pa]. It uses the expression from the !! TEOS10 website. subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. @@ -90,13 +91,15 @@ subroutine calculate_density_array_teos10(T, S, pressure, rho, start, npts, rho_ real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? @@ -120,7 +123,10 @@ subroutine calculate_spec_vol_scalar_teos10(T, S, pressure, specvol, spv_ref) real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0, spv0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the conservative temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the absolute salinity [g kg-1] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -134,8 +140,7 @@ end subroutine calculate_spec_vol_scalar_teos10 !! and pressure [Pa], using the TEOS10 equation of state. !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, spv_ref) - real, dimension(:), intent(in) :: T !< Conservative temperature relative to the surface - !! [degC]. + real, dimension(:), intent(in) :: T !< Conservative temperature [degC]. real, dimension(:), intent(in) :: S !< salinity [g kg-1]. real, dimension(:), intent(in) :: pressure !< pressure [Pa]. real, dimension(:), intent(out) :: specvol !< in situ specific volume [m3 kg-1]. @@ -144,13 +149,15 @@ subroutine calculate_spec_vol_array_teos10(T, S, pressure, specvol, start, npts, real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar if (S(j) < -1.0e-10) then @@ -177,15 +184,17 @@ subroutine calculate_density_derivs_array_teos10(T, S, pressure, drho_dT, drho_d integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? drho_dT(j) = 0.0 ; drho_dS(j) = 0.0 else call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS(j), drho_dct=drho_dT(j)) @@ -206,10 +215,13 @@ subroutine calculate_density_derivs_scalar_teos10(T, S, pressure, drho_dT, drho_ !! [kg m-3 (g/kg)-1]. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] + !Conversions zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp + zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar if (S < -1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) @@ -229,15 +241,17 @@ subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? dSV_dT(j) = 0.0 ; dSV_dS(j) = 0.0 else call gsw_specvol_first_derivatives(zs,zt,zp, v_sa=dSV_dS(j), v_ct=dSV_dT(j)) @@ -252,18 +266,25 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS real, intent(in) :: T !< Conservative temperature [degC] real, intent(in) :: S !< Absolute Salinity [g kg-1] real, intent(in) :: pressure !< pressure [Pa]. - real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T - real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect + !! to S [kg m-3 (g/kg)-2] + real, intent(out) :: drho_dS_dT !< Partial derivative of beta with respect + !! to T [kg m-3 (g/kg)-1 degC-1] + real, intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, intent(out) :: drho_dS_dP !< Partial derivative of beta with respect + !! to pressure [kg m-3 (g/kg)-1 Pa-1] = [s2 m-2 (g/kg)-1] + real, intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] !Conversions zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp + zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp zp = pressure* Pa2db !Convert pressure from Pascal to decibar if (S < -1.0e-10) return !Can we assume safely that this is a missing value? call gsw_rho_second_derivatives(zs, zt, zp, rho_sa_sa=drho_dS_dS, rho_sa_ct=drho_dS_dT, & @@ -277,24 +298,31 @@ subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_ real, dimension(:), intent(in) :: T !< Conservative temperature [degC] real, dimension(:), intent(in) :: S !< Absolute Salinity [g kg-1] real, dimension(:), intent(in) :: pressure !< pressure [Pa]. - real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S - real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T - real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect to T - real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect to pressure - real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect to pressure + real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect + !! to S [kg m-3 (g/kg)-2] + real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with respect + !! to T [kg m-3 (g/kg)-1 degC-1] + real, dimension(:), intent(out) :: drho_dT_dT !< Partial derivative of alpha with respect + !! to T [kg m-3 degC-2] + real, dimension(:), intent(out) :: drho_dS_dP !< Partial derivative of beta with respect + !! to pressure [kg m-3 (g/kg)-1 Pa-1] = [s2 m-2 (g/kg)-1] + real, dimension(:), intent(out) :: drho_dT_dP !< Partial derivative of alpha with respect + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs, zt, zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S,T) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? drho_dS_dS(j) = 0.0 ; drho_dS_dT(j) = 0.0 ; drho_dT_dT(j) = 0.0 drho_dS_dP(j) = 0.0 ; drho_dT_dP(j) = 0.0 else @@ -307,7 +335,7 @@ end subroutine calculate_density_second_derivs_array_teos10 !> This subroutine computes the in situ density of sea water (rho in !! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) -!! (drho_dp [s2 m-2]) from absolute salinity (sal in g/kg), +!! (drho_dp [s2 m-2]) from absolute salinity (sal [g kg-1]), !! conservative temperature (T [degC]), and pressure [Pa]. It uses the !! subroutines from TEOS10 website subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) @@ -322,15 +350,17 @@ subroutine calculate_compress_teos10(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: zs,zt,zp + real :: zs ! Absolute salinity [g kg-1] + real :: zt ! Conservative temperature [degC] + real :: zp ! Pressure converted to decibars [dbar] integer :: j do j=start,start+npts-1 !Conversions zs = S(j) !gsw_sr_from_sp(S(j)) !Convert practical salinity to absolute salinity - zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potantial temp to conservative temp + zt = T(j) !gsw_ct_from_pt(S(j),T(j)) !Convert potential temp to conservative temp zp = pressure(j)* Pa2db !Convert pressure from Pascal to decibar - if (S(j) < -1.0e-10) then ; !Can we assume safely that this is a missing value? + if (S(j) < -1.0e-10) then !Can we assume safely that this is a missing value? rho(j) = 1000.0 ; drho_dp(j) = 0.0 else rho(j) = gsw_rho(zs,zt,zp) diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index a296cfc382..59ebb92c7a 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -17,45 +17,80 @@ module MOM_EOS_UNESCO public calculate_density_scalar_UNESCO, calculate_density_array_UNESCO !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to -!! a reference density, from salinity [PSU], potential temperature [degC], and pressure [Pa], -!! using the UNESCO (1981) equation of state. +!! a reference density, from salinity [PSU], potential temperature [degC] and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). interface calculate_density_UNESCO module procedure calculate_density_scalar_UNESCO, calculate_density_array_UNESCO end interface calculate_density_UNESCO !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect !! to a reference specific volume, from salinity [PSU], potential temperature [degC], and -!! pressure [Pa], using the UNESCO (1981) equation of state. +!! pressure [Pa], using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). interface calculate_spec_vol_UNESCO module procedure calculate_spec_vol_scalar_UNESCO, calculate_spec_vol_array_UNESCO end interface calculate_spec_vol_UNESCO -!>@{ Parameters in the UNESCO equation of state -! The following constants are used to calculate rho0. The notation -! is Rab for the contribution to rho0 from T^aS^b. -real, parameter :: R00 = 999.842594, R10 = 6.793952e-2, R20 = -9.095290e-3, & - R30 = 1.001685e-4, R40 = -1.120083e-6, R50 = 6.536332e-9, R01 = 0.824493, & - R11 = -4.0899e-3, R21 = 7.6438e-5, R31 = -8.2467e-7, R41 = 5.3875e-9, & - R032 = -5.72466e-3, R132 = 1.0227e-4, R232 = -1.6546e-6, R02 = 4.8314e-4 - -! The following constants are used to calculate the secant bulk mod- -! ulus. The notation here is Sab for terms proportional to T^a*S^b, -! Spab for terms proportional to p*T^a*S^b, and SPab for terms +!>@{ Parameters in the UNESCO equation of state, as published in appendix A3 of Gill, 1982. +! The following constants are used to calculate rho0, the density of seawater at 1 +! atmosphere pressure. The notation is Rab for the contribution to rho0 from T^a*S^b. +real, parameter :: R00 = 999.842594 ! A coefficient in the fit for rho0 [kg m-3] +real, parameter :: R10 = 6.793952e-2 ! A coefficient in the fit for rho0 [kg m-3 degC-1] +real, parameter :: R20 = -9.095290e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-2] +real, parameter :: R30 = 1.001685e-4 ! A coefficient in the fit for rho0 [kg m-3 degC-3] +real, parameter :: R40 = -1.120083e-6 ! A coefficient in the fit for rho0 [kg m-3 degC-4] +real, parameter :: R50 = 6.536332e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-5] +real, parameter :: R01 = 0.824493 ! A coefficient in the fit for rho0 [kg m-3 PSU-1] +real, parameter :: R11 = -4.0899e-3 ! A coefficient in the fit for rho0 [kg m-3 degC-1 PSU-1] +real, parameter :: R21 = 7.6438e-5 ! A coefficient in the fit for rho0 [kg m-3 degC-2 PSU-1] +real, parameter :: R31 = -8.2467e-7 ! A coefficient in the fit for rho0 [kg m-3 degC-3 PSU-1] +real, parameter :: R41 = 5.3875e-9 ! A coefficient in the fit for rho0 [kg m-3 degC-4 PSU-1] +real, parameter :: R032 = -5.72466e-3 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] +real, parameter :: R132 = 1.0227e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] +real, parameter :: R232 = -1.6546e-6 ! A coefficient in the fit for rho0 [kg m-3 PSU-3/2] +real, parameter :: R02 = 4.8314e-4 ! A coefficient in the fit for rho0 [kg m-3 PSU-2] + +! The following constants are used to calculate the secant bulk modulus. +! The notation here is Sab for terms proportional to T^a*S^b, +! Spab for terms proportional to p*T^a*S^b, and SP0ab for terms ! proportional to p^2*T^a*S^b. -real, parameter :: S00 = 1.965933e4, S10 = 1.444304e2, S20 = -1.706103, & - S30 = 9.648704e-3, S40 = -4.190253e-5, S01 = 52.84855, S11 = -3.101089e-1, & - S21 = 6.283263e-3, S31 = -5.084188e-5, S032 = 3.886640e-1, S132 = 9.085835e-3, & - S232 = -4.619924e-4, Sp00 = 3.186519, Sp10 = 2.212276e-2, Sp20 = -2.984642e-4, & - Sp30 = 1.956415e-6, Sp01 = 6.704388e-3, Sp11 = -1.847318e-4, Sp21 = 2.059331e-7, & - Sp032 = 1.480266e-4, SP000 = 2.102898e-4, SP010 = -1.202016e-5, SP020 = 1.394680e-7, & - SP001 = -2.040237e-6, SP011 = 6.128773e-8, SP021 = 6.207323e-10 +! Note that these values differ from those in Appendix A of Gill (1982) because the expressions +! from Jackett and MacDougall (1995) use potential temperature, rather than in situ temperature. +real, parameter :: S00 = 1.965933e4 ! A coefficient in the secant bulk modulus fit [bar] +real, parameter :: S10 = 1.444304e2 ! A coefficient in the secant bulk modulus fit [bar degC-1] +real, parameter :: S20 = -1.706103 ! A coefficient in the secant bulk modulus fit [bar degC-2] +real, parameter :: S30 = 9.648704e-3 ! A coefficient in the secant bulk modulus fit [bar degC-3] +real, parameter :: S40 = -4.190253e-5 ! A coefficient in the secant bulk modulus fit [bar degC-4] +real, parameter :: S01 = 52.84855 ! A coefficient in the secant bulk modulus fit [bar PSU-1] +real, parameter :: S11 = -3.101089e-1 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-1] +real, parameter :: S21 = 6.283263e-3 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-1] +real, parameter :: S31 = -5.084188e-5 ! A coefficient in the secant bulk modulus fit [bar degC-3 PSU-1] +real, parameter :: S032 = 3.886640e-1 ! A coefficient in the secant bulk modulus fit [bar PSU-3/2] +real, parameter :: S132 = 9.085835e-3 ! A coefficient in the secant bulk modulus fit [bar degC-1 PSU-3/2] +real, parameter :: S232 = -4.619924e-4 ! A coefficient in the secant bulk modulus fit [bar degC-2 PSU-3/2] + +real, parameter :: Sp00 = 3.186519 ! A coefficient in the secant bulk modulus fit [nondim] +real, parameter :: Sp10 = 2.212276e-2 ! A coefficient in the secant bulk modulus fit [degC-1] +real, parameter :: Sp20 = -2.984642e-4 ! A coefficient in the secant bulk modulus fit [degC-2] +real, parameter :: Sp30 = 1.956415e-6 ! A coefficient in the secant bulk modulus fit [degC-3] +real, parameter :: Sp01 = 6.704388e-3 ! A coefficient in the secant bulk modulus fit [PSU-1] +real, parameter :: Sp11 = -1.847318e-4 ! A coefficient in the secant bulk modulus fit [degC-1 PSU-1] +real, parameter :: Sp21 = 2.059331e-7 ! A coefficient in the secant bulk modulus fit [degC-2 PSU-1] +real, parameter :: Sp032 = 1.480266e-4 ! A coefficient in the secant bulk modulus fit [PSU-3/2] + +real, parameter :: SP000 = 2.102898e-4 ! A coefficient in the secant bulk modulus fit [bar-1] +real, parameter :: SP010 = -1.202016e-5 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1] +real, parameter :: SP020 = 1.394680e-7 ! A coefficient in the secant bulk modulus fit [bar-1 degC-2] +real, parameter :: SP001 = -2.040237e-6 ! A coefficient in the secant bulk modulus fit [bar-1 PSU-1] +real, parameter :: SP011 = 6.128773e-8 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-1] +real, parameter :: SP021 = 6.207323e-10 ! A coefficient in the secant bulk modulus fit [bar-1 degC-1 PSU-2] !>@} contains -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from salinity (S [PSU]), potential temperature (T [degC]), and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +!! If rho_ref is present, rho is an anomaly from rho_ref. subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, intent(in) :: T !< Potential temperature relative to the surface [degC]. real, intent(in) :: S !< Salinity [PSU]. @@ -64,8 +99,10 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real, dimension(1) :: T0, S0, pressure0 - real, dimension(1) :: rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the in situ density [kg m-3] T0(1) = T S0(1) = S @@ -76,9 +113,10 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho, rho_ref) end subroutine calculate_density_scalar_UNESCO -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) from salinity (S [PSU]), potential temperature -!! (T [degC]), and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! from salinity (S [PSU]), potential temperature (T [degC]) and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). +!! If rho_ref is present, rho is an anomaly from rho_ref. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface [degC]. real, dimension(:), intent(in) :: S !< salinity [PSU]. @@ -89,8 +127,12 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ real, optional, intent(in) :: rho_ref !< A reference density [kg m-3]. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: sig0 ! The anomaly of rho0 from R00 [kg m-3]. @@ -103,9 +145,9 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). @@ -130,9 +172,9 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts, rho_ enddo end subroutine calculate_density_array_UNESCO -!> This subroutine computes the in situ specific volume of sea water (specvol in -!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ specific volume of sea water (specvol in [m3 kg-1]) +!! from salinity (S [PSU]), potential temperature (T [degC]) and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, intent(in) :: T !< potential temperature relative to the surface @@ -143,7 +185,10 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0, spv0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -151,9 +196,9 @@ subroutine calculate_spec_vol_scalar_UNESCO(T, S, pressure, specvol, spv_ref) specvol = spv0(1) end subroutine calculate_spec_vol_scalar_UNESCO -!> This subroutine computes the in situ specific volume of sea water (specvol in -!! [m3 kg-1]) from salinity (S [PSU]), potential temperature (T [degC]) -!! and pressure [Pa], using the UNESCO (1981) equation of state. +!> This subroutine computes the in situ specific volume of sea water (specvol in [m3 kg-1]) +!! from salinity (S [PSU]), potential temperature (T [degC]) and pressure [Pa], +!! using the UNESCO (1981) equation of state, as refit by Jackett and McDougall (1995). !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the surface @@ -166,8 +211,12 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. real :: p1, p2 ! Pressure (in bars) to the 1st and 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: ks ! The secant bulk modulus [bar]. @@ -180,9 +229,9 @@ subroutine calculate_spec_vol_array_UNESCO(T, S, pressure, specvol, start, npts, cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). @@ -222,8 +271,13 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s12, s_local, s32, s2 ! Salinity to the 1/2 - 2nd powers [PSU^n]. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s12 ! The square root of salinity [PSU1/2] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. real :: rho0 ! Density at 1 bar pressure [kg m-3]. real :: ks ! The secant bulk modulus [bar]. @@ -240,9 +294,9 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s12 = sqrt(s_local); s32 = s_local*s12 + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s12 = sqrt(s_local) ; s32 = s_local*s12 ! compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ) @@ -293,14 +347,20 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: t_local, t2, t3, t4, t5 ! Temperature to the 1st - 5th power [degC^n]. - real :: s_local, s32, s2 ! Salinity to the 1st, 3/2, & 2nd power [PSU^n]. - real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. - real :: rho0 ! Density at 1 bar pressure [kg m-3]. - real :: ks ! The secant bulk modulus [bar]. - real :: ks_0, ks_1, ks_2 - real :: dks_dp ! The derivative of the secant bulk modulus - ! with pressure, nondimensional. + real :: t_local ! A copy of the temperature at a point [degC] + real :: t2, t3 ! Temperature squared [degC2] and cubed [degC3] + real :: t4, t5 ! Temperature to the 4th power [degC4] and 5th power [degC5] + real :: s_local ! A copy of the salinity at a point [PSU] + real :: s32 ! The square root of salinity cubed [PSU3/2] + real :: s2 ! Salinity squared [PSU2]. + real :: p1, p2 ! Pressure to the 1st & 2nd power [bar] and [bar2]. + real :: rho0 ! Density at 1 bar pressure [kg m-3]. + real :: ks ! The secant bulk modulus [bar]. + real :: ks_0 ! The secant bulk modulus at zero pressure [bar]. + real :: ks_1 ! The derivative of the secant bulk modulus with pressure at zero pressure [nondim]. + real :: ks_2 ! The second derivative of the secant bulk modulus with pressure at zero pressure [nondim]. + real :: dks_dp ! The derivative of the secant bulk modulus + ! with pressure [nondim] integer :: j do j=start,start+npts-1 @@ -309,9 +369,9 @@ subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) cycle endif - p1 = pressure(j)*1.0e-5; p2 = p1*p1 - t_local = T(j); t2 = t_local*t_local; t3 = t_local*t2; t4 = t2*t2; t5 = t3*t2 - s_local = S(j); s2 = s_local*s_local; s32 = s_local*sqrt(s_local) + p1 = pressure(j)*1.0e-5 ; p2 = p1*p1 + t_local = T(j) ; t2 = t_local*t_local ; t3 = t_local*t2 ; t4 = t2*t2 ; t5 = t3*t2 + s_local = S(j) ; s2 = s_local*s_local ; s32 = s_local*sqrt(s_local) ! Compute rho(s,theta,p=0) - (same as rho(s,t_insitu,p=0) ). diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index c2e50287b2..77e0d17ff3 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -27,15 +27,17 @@ module MOM_EOS_Wright !> Compute the in situ density of sea water (in [kg m-3]), or its anomaly with respect to -!! a reference density, from salinity (in psu), potential temperature (in deg C), and pressure [Pa], -!! using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! a reference density, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_density_wright module procedure calculate_density_scalar_wright, calculate_density_array_wright end interface calculate_density_wright !> Compute the in situ specific volume of sea water (in [m3 kg-1]), or an anomaly with respect -!! to a reference specific volume, from salinity (in psu), potential temperature (in deg C), and -!! pressure [Pa], using the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! to a reference specific volume, from salinity in practical salinity units ([PSU]), potential +!! temperature (in degrees Celsius [degC]), and pressure [Pa], using the expressions from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. interface calculate_spec_vol_wright module procedure calculate_spec_vol_scalar_wright, calculate_spec_vol_array_wright end interface calculate_spec_vol_wright @@ -64,11 +66,25 @@ module MOM_EOS_Wright ! Following are the values for the reduced range formula. -real, parameter :: a0 = 7.057924e-4, a1 = 3.480336e-7, a2 = -1.112733e-7 ! a0/a1 ~= 2028 ; a0/a2 ~= -6343 -real, parameter :: b0 = 5.790749e8, b1 = 3.516535e6, b2 = -4.002714e4 ! b0/b1 ~= 165 ; b0/b4 ~= 974 -real, parameter :: b3 = 2.084372e2, b4 = 5.944068e5, b5 = -9.643486e3 -real, parameter :: c0 = 1.704853e5, c1 = 7.904722e2, c2 = -7.984422 ! c0/c1 ~= 216 ; c0/c4 ~= -740 -real, parameter :: c3 = 5.140652e-2, c4 = -2.302158e2, c5 = -3.079464 + ! Note that a0/a1 ~= 2028 [degC] ; a0/a2 ~= -6343 [PSU] + ! b0/b1 ~= 165 [degC] ; b0/b4 ~= 974 [PSU] + ! c0/c1 ~= 216 [degC] ; c0/c4 ~= -740 [PSU] + ! and also that (as always) [Pa] = [kg m-1 s-2] +real, parameter :: a0 = 7.057924e-4 ! A parameter in the Wright alpha_0 fit [m3 kg-1] +real, parameter :: a1 = 3.480336e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 degC-1] +real, parameter :: a2 = -1.112733e-7 ! A parameter in the Wright alpha_0 fit [m3 kg-1 PSU-1] +real, parameter :: b0 = 5.790749e8 ! A parameter in the Wright p_0 fit [Pa] +real, parameter :: b1 = 3.516535e6 ! A parameter in the Wright p_0 fit [Pa degC-1] +real, parameter :: b2 = -4.002714e4 ! A parameter in the Wright p_0 fit [Pa degC-2] +real, parameter :: b3 = 2.084372e2 ! A parameter in the Wright p_0 fit [Pa degC-3] +real, parameter :: b4 = 5.944068e5 ! A parameter in the Wright p_0 fit [Pa PSU-1] +real, parameter :: b5 = -9.643486e3 ! A parameter in the Wright p_0 fit [Pa degC-1 PSU-1] +real, parameter :: c0 = 1.704853e5 ! A parameter in the Wright lambda fit [m2 s-2] +real, parameter :: c1 = 7.904722e2 ! A parameter in the Wright lambda fit [m2 s-2 degC-1] +real, parameter :: c2 = -7.984422 ! A parameter in the Wright lambda fit [m2 s-2 degC-2] +real, parameter :: c3 = 5.140652e-2 ! A parameter in the Wright lambda fit [m2 s-2 degC-3] +real, parameter :: c4 = -2.302158e2 ! A parameter in the Wright lambda fit [m2 s-2 PSU-1] +real, parameter :: c5 = -3.079464 ! A parameter in the Wright lambda fit [m2 s-2 degC-1 PSU-1] !>@} contains @@ -86,13 +102,16 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho, rho_ref) ! *====================================================================* ! * This subroutine computes the in situ density of sea water (rho in * -! * [kg m-3]) from salinity (S [PSU]), potential temperature * -! * (T [degC]), and pressure [Pa]. It uses the expression from * +! * [kg m-3]) from salinity (S [PSU]), potential temperature * +! * (T [degC]), and pressure [Pa]. It uses the expression from * ! * Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. * ! * Coded by R. Hallberg, 7/00 * ! *====================================================================* - real, dimension(1) :: T0, S0, pressure0, rho0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: rho0 ! A 1-d array with a copy of the density [kg m-3] T0(1) = T S0(1) = S @@ -118,8 +137,13 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts, rho_ ! Original coded by R. Hallberg, 7/00, anomaly coded in 3/18. ! Local variables - real :: al0, p0, lambda - real :: al_TS, p_TSp, lam_TS, pa_000 + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: al_TS ! The contributions of temperature and salinity to al0 [m3 kg-1] + real :: p_TSp ! A combination of the pressure and the temperature and salinity contributions to p0 [Pa] + real :: lam_TS ! The contributions of temperature and salinity to lambda [m2 s-2] + real :: pa_000 ! A corrected offset to the pressure, including contributions from rho_ref [Pa] integer :: j if (present(rho_ref)) pa_000 = (b0*(1.0 - a0*rho_ref) - rho_ref*c0) @@ -155,7 +179,10 @@ subroutine calculate_spec_vol_scalar_wright(T, S, pressure, specvol, spv_ref) real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real, dimension(1) :: T0, S0, pressure0, spv0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the potential temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: pressure0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: spv0 ! A 1-d array with a copy of the specific volume [m3 kg-1] T0(1) = T ; S0(1) = S ; pressure0(1) = pressure @@ -170,7 +197,7 @@ end subroutine calculate_spec_vol_scalar_wright !! If spv_ref is present, specvol is an anomaly from spv_ref. subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, spv_ref) real, dimension(:), intent(in) :: T !< potential temperature relative to the - !! surface [degC]. + !! surface [degC]. real, dimension(:), intent(in) :: S !< salinity [PSU]. real, dimension(:), intent(in) :: pressure !< pressure [Pa]. real, dimension(:), intent(inout) :: specvol !< in situ specific volume [m3 kg-1]. @@ -179,7 +206,9 @@ subroutine calculate_spec_vol_array_wright(T, S, pressure, specvol, start, npts, real, optional, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. ! Local variables - real :: al0, p0, lambda + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] integer :: j do j=start,start+npts-1 @@ -209,7 +238,10 @@ subroutine calculate_density_derivs_array_wright(T, S, pressure, drho_dT, drho_d integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: al0, p0, lambda, I_denom2 + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom2 ! The inverse of the square of the denominator of density in the Wright EOS [s4 m-4] integer :: j do j=start,start+npts-1 @@ -241,8 +273,11 @@ subroutine calculate_density_derivs_scalar_wright(T, S, pressure, drho_dT, drho_ !! in [kg m-3 PSU-1]. ! Local variables needed to promote the input/output scalars to 1-element arrays - real, dimension(1) :: T0, S0, P0 - real, dimension(1) :: drdt0, drds0 + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdt0 ! The derivative of density with temperature [kg m-3 degC-1] + real, dimension(1) :: drds0 ! The derivative of density with salinity [kg m-3 PSU-1] T0(1) = T S0(1) = S @@ -261,19 +296,28 @@ subroutine calculate_density_second_derivs_array_wright(T, S, P, drho_ds_ds, drh real, dimension(:), intent(in ) :: P !< Pressure [Pa] real, dimension(:), intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect !! to S [kg m-3 PSU-2] - real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respcct + real, dimension(:), intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect !! to T [kg m-3 PSU-1 degC-1] real, dimension(:), intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect !! to T [kg m-3 degC-2] real, dimension(:), intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect - !! to pressure [kg m-3 PSU-1 Pa-1] + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] real, dimension(:), intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect - !! to pressure [kg m-3 degC-1 Pa-1] + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] integer, intent(in ) :: start !< Starting index in T,S,P integer, intent(in ) :: npts !< Number of points to loop over ! Local variables - real :: z0, z1, z2, z3, z4, z5, z6 ,z7, z8, z9, z10, z11, z2_2, z2_3 + real :: z0, z1 ! Local work variables [Pa] + real :: z2, z4 ! Local work variables [m2 s-2] + real :: z3, z5 ! Local work variables [Pa degC-1] + real :: z6, z8 ! Local work variables [m2 s-2 degC-1] + real :: z7 ! A local work variable [m2 s-2 PSU-1] + real :: z9 ! A local work variable [m3 kg-1] + real :: z10 ! A local work variable [Pa PSU-1] + real :: z11 ! A local work variable [Pa m2 s-2 PSU-1] = [kg m s-4 PSU-1] + real :: z2_2 ! A local work variable [m4 s-4] + real :: z2_3 ! A local work variable [m6 s-6] integer :: j ! Based on the above expression with common terms factored, there probably exists a more numerically stable ! and/or efficient expression @@ -313,17 +357,26 @@ subroutine calculate_density_second_derivs_scalar_wright(T, S, P, drho_ds_ds, dr real, intent(in ) :: P !< pressure [Pa] real, intent( out) :: drho_ds_ds !< Partial derivative of beta with respect !! to S [kg m-3 PSU-2] - real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respcct + real, intent( out) :: drho_ds_dt !< Partial derivative of beta with respect !! to T [kg m-3 PSU-1 degC-1] real, intent( out) :: drho_dt_dt !< Partial derivative of alpha with respect !! to T [kg m-3 degC-2] real, intent( out) :: drho_ds_dp !< Partial derivative of beta with respect - !! to pressure [kg m-3 PSU-1 Pa-1] + !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] real, intent( out) :: drho_dt_dp !< Partial derivative of alpha with respect - !! to pressure [kg m-3 degC-1 Pa-1] + !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] ! Local variables - real, dimension(1) :: T0, S0, P0 - real, dimension(1) :: drdsds, drdsdt, drdtdt, drdsdp, drdtdp + real, dimension(1) :: T0 ! A 1-d array with a copy of the temperature [degC] + real, dimension(1) :: S0 ! A 1-d array with a copy of the salinity [PSU] + real, dimension(1) :: p0 ! A 1-d array with a copy of the pressure [Pa] + real, dimension(1) :: drdsds ! The second derivative of density with salinity [kg m-3 PSU-2] + real, dimension(1) :: drdsdt ! The second derivative of density with salinity and + ! temperature [kg m-3 PSU-1 degC-1] + real, dimension(1) :: drdtdt ! The second derivative of density with temperature [kg m-3 degC-2] + real, dimension(1) :: drdsdp ! The second derivative of density with salinity and + ! pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + real, dimension(1) :: drdtdp ! The second derivative of density with temperature and + ! pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] T0(1) = T S0(1) = S @@ -346,12 +399,14 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start real, intent(inout), dimension(:) :: dSV_dT !< The partial derivative of specific volume with !! potential temperature [m3 kg-1 degC-1]. real, intent(inout), dimension(:) :: dSV_dS !< The partial derivative of specific volume with - !! salinity [m3 kg-1 / Pa]. + !! salinity [m3 kg-1 PSU-1]. integer, intent(in) :: start !< The starting point in the arrays. integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real :: p0, lambda, I_denom + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of specific volume in the Wright EOS [Pa-1] integer :: j do j=start,start+npts-1 @@ -370,11 +425,10 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_wright -!> This subroutine computes the in situ density of sea water (rho in -!! [kg m-3]) and the compressibility (drho/dp = C_sound^-2) -!! (drho_dp [s2 m-2]) from salinity (sal in psu), potential -!! temperature (T [degC]), and pressure [Pa]. It uses the expressions -!! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!> This subroutine computes the in situ density of sea water (rho in [kg m-3]) +!! and the compressibility (drho/dp = C_sound^-2) (drho_dp [s2 m-2]) from +!! salinity (sal [PSU]), potential temperature (T [degC]), and pressure [Pa]. +!! It uses the expressions from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. !! Coded by R. Hallberg, 1/01 subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface [degC]. @@ -389,7 +443,10 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) ! Coded by R. Hallberg, 1/01 ! Local variables - real :: al0, p0, lambda, I_denom + real :: al0 ! The specific volume at 0 lambda in the Wright EOS [m3 kg-1] + real :: p0 ! The pressure offset in the Wright EOS [Pa] + real :: lambda ! The sound speed squared at 0 alpha in the Wright EOS [m2 s-2] + real :: I_denom ! The inverse of the denominator of density in the Wright EOS [s2 m-2] integer :: j do j=start,start+npts-1 @@ -421,7 +478,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & intent(in) :: z_b !< Height at the top of the layer [Z ~> m]. real, intent(in) :: rho_ref !< A mean density [R ~> kg m-3], that is subtracted !! out to reduce the magnitude of each of the integrals. - !! (The pressure is calucated as p~=-z*rho_0*G_e.) + !! (The pressure is calculated as p~=-z*rho_0*G_e.) real, intent(in) :: rho_0 !< Density [R ~> kg m-3], that is used !! to calculate the pressure (as p~=-z*rho_0*G_e) !! used in the equation of state. @@ -454,7 +511,7 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale !! temperature into degC [degC C-1 ~> 1] real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure - !! into ppt [ppt S-1 ~> 1]. + !! into PSU [PSU S-1 ~> 1]. real, optional, intent(in) :: Z_0p !< The height at which the pressure is 0 [Z ~> m] ! Local variables @@ -488,20 +545,20 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HI, & ! pres_scale [R L2 T-2 Pa-1 ~> 1]. real :: z0pres ! The height at which the pressure is zero [Z ~> m] real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] - real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 ppt-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] - real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa ppt-1] - real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 ppt-1] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] - real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 ppt-1] - real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 ppt-1] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] 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. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j, m ! These array bounds work for the indexing convention of the input arrays, but @@ -716,7 +773,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real, optional, intent(in) :: temp_scale !< A multiplicative factor by which to scale !! temperature into degC [degC C-1 ~> 1] real, optional, intent(in) :: saln_scale !< A multiplicative factor to convert pressure - !! into ppt [ppt S-1 ~> 1]. + !! into PSU [PSU S-1 ~> 1]. ! Local variables real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed) :: al0_2d ! A term in the Wright EOS [R-1 ~> m3 kg-1] @@ -743,27 +800,27 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & real :: intp(5) ! The integrals of specific volume with pressure at the ! 5 sub-column locations [L2 T-2 ~> m2 s-2]. real :: a1s ! Partly rescaled version of a1 [m3 kg-1 C-1 ~> m3 kg-1 degC-1] - real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 ppt-1] + real :: a2s ! Partly rescaled version of a2 [m3 kg-1 S-1 ~> m3 kg-1 PSU-1] real :: b1s ! Partly rescaled version of b1 [Pa C-1 ~> Pa degC-1] real :: b2s ! Partly rescaled version of b2 [Pa C-2 ~> Pa degC-2] real :: b3s ! Partly rescaled version of b3 [Pa C-3 ~> Pa degC-3] - real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa ppt-1] - real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 ppt-1] + real :: b4s ! Partly rescaled version of b4 [Pa S-1 ~> Pa PSU-1] + real :: b5s ! Partly rescaled version of b5 [Pa C-1 S-1 ~> Pa degC-1 PSU-1] real :: c1s ! Partly rescaled version of c1 [m2 s-2 C-1 ~> m2 s-2 degC-1] real :: c2s ! Partly rescaled version of c2 [m2 s-2 C-2 ~> m2 s-2 degC-2] real :: c3s ! Partly rescaled version of c3 [m2 s-2 C-3 ~> m2 s-2 degC-3] - real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 ppt-1] - real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 ppt-1] + real :: c4s ! Partly rescaled version of c4 [m2 s-2 S-1 ~> m2 s-2 PSU-1] + real :: c5s ! Partly rescaled version of c5 [m2 s-2 C-1 S-1 ~> m2 s-2 degC-1 PSU-1] 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. + real, parameter :: C1_3 = 1.0/3.0, C1_7 = 1.0/7.0 ! Rational constants [nondim] + real, parameter :: C1_9 = 1.0/9.0, C1_90 = 1.0/90.0 ! Rational constants [nondim] integer :: Isq, Ieq, Jsq, Jeq, ish, ieh, jsh, jeh, i, j, m, halo Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) ish = HI%isc-halo ; ieh = HI%iec+halo ; jsh = HI%jsc-halo ; jeh = HI%jec+halo - if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh); endif - if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh); endif + if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh) ; endif + if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh) ; endif al0_scale = 1.0 ; if (present(SV_scale)) al0_scale = SV_scale @@ -842,7 +899,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. al0 = wtT_L*al0_2d(i,j) + wtT_R*al0_2d(i+1,j) p0 = wtT_L*p0_2d(i,j) + wtT_R*p0_2d(i+1,j) lambda = wtT_L*lambda_2d(i,j) + wtT_R*lambda_2d(i+1,j) @@ -883,7 +940,7 @@ subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, spv_ref, HI, dza, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. al0 = wt_L*al0_2d(i,j) + wt_R*al0_2d(i,j+1) p0 = wt_L*p0_2d(i,j) + wt_R*p0_2d(i,j+1) lambda = wt_L*lambda_2d(i,j) + wt_R*lambda_2d(i,j+1) diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index 2b4f99adf0..dd45e6cd81 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -21,16 +21,16 @@ module MOM_EOS_linear ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Compute the density of sea water (in kg/m^3), or its anomaly from a reference density, -!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) -!! and pressure [Pa]. +!> Compute the density of sea water (in [kg m-3]), or its anomaly from a reference density, +!! using a simple linear equation of state from salinity in practical salinity units ([PSU]), +!! potential temperature in degrees Celsius ([degC]) and pressure [Pa]. interface calculate_density_linear module procedure calculate_density_scalar_linear, calculate_density_array_linear end interface calculate_density_linear -!> Compute the specific volume of sea water (in m^3/kg), or its anomaly from a reference value, -!! using a simple linear equation of state from salinity (in psu), potential temperature (in deg C) -!! and pressure [Pa]. +!> Compute the specific volume of sea water (in [m3 kg-1]), or its anomaly from a reference value, +!! using a simple linear equation of state from salinity in practical salinity units ([PSU]), +!! potential temperature in degrees Celsius ([degC]) and pressure [Pa]. interface calculate_spec_vol_linear module procedure calculate_spec_vol_scalar_linear, calculate_spec_vol_array_linear end interface calculate_spec_vol_linear @@ -75,7 +75,7 @@ subroutine calculate_density_scalar_linear(T, S, pressure, rho, & end subroutine calculate_density_scalar_linear !> This subroutine computes the density of sea water with a trivial -!! linear equation of state (in kg/m^3) from salinity (sal in psu), +!! linear equation of state (in [kg m-3]) from salinity (sal [PSU]), !! potential temperature (T [degC]), and pressure [Pa]. subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS, rho_ref) @@ -331,7 +331,7 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HI, & intent(in) :: T !< Potential temperature relative to the surface !! [C ~> degC]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: S !< Salinity [S ?~> PSU]. + intent(in) :: S !< Salinity [S ~> PSU]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & intent(in) :: z_t !< Height at the top of the layer in depth units [Z ~> m]. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & @@ -561,8 +561,8 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB halo = 0 ; if (present(halo_size)) halo = MAX(halo_size,0) ish = HI%isc-halo ; ieh = HI%iec+halo ; jsh = HI%jsc-halo ; jeh = HI%jec+halo - if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh); endif - if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh); endif + if (present(intx_dza)) then ; ish = MIN(Isq,ish) ; ieh = MAX(Ieq+1,ieh) ; endif + if (present(inty_dza)) then ; jsh = MIN(Jsq,jsh) ; jeh = MAX(Jeq+1,jeh) ; endif do_massWeight = .false. if (present(useMassWghtInterp)) then ; if (useMassWghtInterp) then @@ -612,7 +612,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i+1,j) - p_t(i+1,j)) dRho_TS = dRho_dT*(wtT_L*T(i,j) + wtT_R*T(i+1,j)) + & @@ -657,7 +657,7 @@ subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & wtT_L = wt_L*hWt_LL + wt_R*hWt_RL ; wtT_R = wt_L*hWt_LR + wt_R*hWt_RR ! T, S, and p are interpolated in the horizontal. The p interpolation - ! is linear, but for T and S it may be thickness wekghted. + ! is linear, but for T and S it may be thickness weighted. dp = wt_L*(p_b(i,j) - p_t(i,j)) + wt_R*(p_b(i,j+1) - p_t(i,j+1)) dRho_TS = dRho_dT*(wtT_L*T(i,j) + wtT_R*T(i,j+1)) + & diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index f0b22c8f4e..16a64c89ed 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -28,7 +28,7 @@ module MOM_TFreeze module procedure calculate_TFreeze_Millero_scalar, calculate_TFreeze_Millero_array end interface calculate_TFreeze_Millero -!> Compute the freezing point conservative temperature [degC] from absolute salinity [g/kg] +!> Compute the freezing point conservative temperature [degC] from absolute salinity [g kg-1] !! and pressure [Pa] using the TEOS10 package. interface calculate_TFreeze_teos10 module procedure calculate_TFreeze_teos10_scalar, calculate_TFreeze_teos10_array @@ -84,13 +84,15 @@ end subroutine calculate_TFreeze_linear_array !! expression for potential temperature (not in situ temperature), using a !! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) - real, intent(in) :: S !< Salinity in PSU. - real, intent(in) :: pres !< Pressure [Pa]. - real, intent(out) :: T_Fr !< Freezing point potential temperature [degC]. + real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: pres !< Pressure [Pa] + real, intent(out) :: T_Fr !< Freezing point potential temperature [degC] ! Local variables - real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 - real, parameter :: dTFr_dp = -7.75e-8 + real, parameter :: cS1 = -0.0575 ! A term in the freezing point fit [degC PSU-1] + real, parameter :: cS3_2 = 1.710523e-3 ! A term in the freezing point fit [degC PSU-3/2] + real, parameter :: cS2 = -2.154996e-4 ! A term in the freezing point fit [degC PSU-2] + real, parameter :: dTFr_dp = -7.75e-8 ! Derivative of freezing point with pressure [degC Pa-1] T_Fr = S*(cS1 + (cS3_2 * sqrt(max(S,0.0)) + cS2 * S)) + dTFr_dp*pres @@ -110,8 +112,10 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) integer, intent(in) :: npts !< The number of values to calculate. ! Local variables - real, parameter :: cS1 = -0.0575, cS3_2 = 1.710523e-3, cS2 = -2.154996e-4 - real, parameter :: dTFr_dp = -7.75e-8 + real, parameter :: cS1 = -0.0575 ! A term in the freezing point fit [degC PSU-1] + real, parameter :: cS3_2 = 1.710523e-3 ! A term in the freezing point fit [degC PSU-3/2] + real, parameter :: cS2 = -2.154996e-4 ! A term in the freezing point fit [degC PSU-2] + real, parameter :: dTFr_dp = -7.75e-8 ! Derivative of freezing point with pressure [degC Pa-1] integer :: j do j=start,start+npts-1 @@ -121,17 +125,18 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) end subroutine calculate_TFreeze_Millero_array -!> This subroutine computes the freezing point conservative temperature -!! [degC] from absolute salinity [g/kg], and pressure [Pa] using the +!> This subroutine computes the freezing point conservative temperature [degC] +!! from absolute salinity [g kg-1], and pressure [Pa] using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) - real, intent(in) :: S !< Absolute salinity [g/kg]. + real, intent(in) :: S !< Absolute salinity [g kg-1]. real, intent(in) :: pres !< Pressure [Pa]. real, intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. ! Local variables - real, dimension(1) :: S0, pres0 - real, dimension(1) :: tfr0 + real, dimension(1) :: S0 ! Salinity at a point [g kg-1] + real, dimension(1) :: pres0 ! Pressure at a point [Pa] + real, dimension(1) :: tfr0 ! The freezing temperature [degC] S0(1) = S pres0(1) = pres @@ -141,22 +146,23 @@ subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_teos10_scalar -!> This subroutine computes the freezing point conservative temperature -!! [degC] from absolute salinity [g/kg], and pressure [Pa] using the +!> This subroutine computes the freezing point conservative temperature [degC] +!! from absolute salinity [g kg-1], and pressure [Pa] using the !! TEOS10 package. subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) - real, dimension(:), intent(in) :: S !< absolute salinity [g/kg]. + real, dimension(:), intent(in) :: S !< absolute salinity [g kg-1]. real, dimension(:), intent(in) :: pres !< pressure [Pa]. real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature [degC]. integer, intent(in) :: start !< the starting point in the arrays. integer, intent(in) :: npts !< the number of values to calculate. ! Local variables - real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar. - real :: zs,zp + real, parameter :: Pa2db = 1.e-4 ! The conversion factor from Pa to dbar [dbar Pa-1] + real :: zs ! Salinity at a point [g kg-1] + real :: zp ! Pressures in [dbar] integer :: j ! Assume sea-water contains no dissolved air. - real, parameter :: saturation_fraction = 0.0 + real, parameter :: saturation_fraction = 0.0 ! Air saturation fraction in seawater [nondim] do j=start,start+npts-1 !Conversions diff --git a/src/framework/MOM_array_transform.F90 b/src/framework/MOM_array_transform.F90 index d524f618a3..66c9925f11 100644 --- a/src/framework/MOM_array_transform.F90 +++ b/src/framework/MOM_array_transform.F90 @@ -71,9 +71,9 @@ module MOM_array_transform !> Rotate the elements of a 2d real array along first and second axes. subroutine rotate_array_real_2d(A_in, turns, A) - real, intent(in) :: A_in(:,:) !< Unrotated array + real, intent(in) :: A_in(:,:) !< Unrotated array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:) !< Rotated array + real, intent(out) :: A(:,:) !< Rotated array [arbitrary] integer :: m, n @@ -96,9 +96,9 @@ end subroutine rotate_array_real_2d !> Rotate the elements of a 3d real array along first and second axes. subroutine rotate_array_real_3d(A_in, turns, A) - real, intent(in) :: A_in(:,:,:) !< Unrotated array + real, intent(in) :: A_in(:,:,:) !< Unrotated array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:) !< Rotated array + real, intent(out) :: A(:,:,:) !< Rotated array [arbitrary] integer :: k @@ -110,9 +110,9 @@ end subroutine rotate_array_real_3d !> Rotate the elements of a 4d real array along first and second axes. subroutine rotate_array_real_4d(A_in, turns, A) - real, intent(in) :: A_in(:,:,:,:) !< Unrotated array + real, intent(in) :: A_in(:,:,:,:) !< Unrotated array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:,:) !< Rotated array + real, intent(out) :: A(:,:,:,:) !< Rotated array [arbitrary] integer :: n @@ -174,11 +174,11 @@ end subroutine rotate_array_logical !> Rotate the elements of a 2d real array pair along first and second axes. subroutine rotate_array_pair_real_2d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:) !< Unrotated scalar array pair - real, intent(in) :: B_in(:,:) !< Unrotated scalar array pair + real, intent(in) :: A_in(:,:) !< Unrotated scalar array pair [arbitrary] + real, intent(in) :: B_in(:,:) !< Unrotated scalar array pair [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:) !< Rotated scalar array pair - real, intent(out) :: B(:,:) !< Rotated scalar array pair + real, intent(out) :: A(:,:) !< Rotated scalar array pair [arbitrary] + real, intent(out) :: B(:,:) !< Rotated scalar array pair [arbitrary] if (modulo(turns, 2) /= 0) then call rotate_array(B_in, turns, A) @@ -192,11 +192,11 @@ end subroutine rotate_array_pair_real_2d !> Rotate the elements of a 3d real array pair along first and second axes. subroutine rotate_array_pair_real_3d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:,:) !< Unrotated scalar array pair - real, intent(in) :: B_in(:,:,:) !< Unrotated scalar array pair + real, intent(in) :: A_in(:,:,:) !< Unrotated scalar array pair [arbitrary] + real, intent(in) :: B_in(:,:,:) !< Unrotated scalar array pair [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:) !< Rotated scalar array pair - real, intent(out) :: B(:,:,:) !< Rotated scalar array pair + real, intent(out) :: A(:,:,:) !< Rotated scalar array pair [arbitrary] + real, intent(out) :: B(:,:,:) !< Rotated scalar array pair [arbitrary] integer :: k @@ -227,11 +227,11 @@ end subroutine rotate_array_pair_integer !> Rotate the elements of a 2d real vector along first and second axes. subroutine rotate_vector_real_2d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:) !< First component of unrotated vector - real, intent(in) :: B_in(:,:) !< Second component of unrotated vector + real, intent(in) :: A_in(:,:) !< First component of unrotated vector [arbitrary] + real, intent(in) :: B_in(:,:) !< Second component of unrotated vector [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:) !< First component of rotated vector - real, intent(out) :: B(:,:) !< Second component of unrotated vector + real, intent(out) :: A(:,:) !< First component of rotated vector [arbitrary] + real, intent(out) :: B(:,:) !< Second component of unrotated vector [arbitrary] call rotate_array_pair(A_in, B_in, turns, A, B) @@ -245,11 +245,11 @@ end subroutine rotate_vector_real_2d !> Rotate the elements of a 3d real vector along first and second axes. subroutine rotate_vector_real_3d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:,:) !< First component of unrotated vector - real, intent(in) :: B_in(:,:,:) !< Second component of unrotated vector + real, intent(in) :: A_in(:,:,:) !< First component of unrotated vector [arbitrary] + real, intent(in) :: B_in(:,:,:) !< Second component of unrotated vector [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:) !< First component of rotated vector - real, intent(out) :: B(:,:,:) !< Second component of unrotated vector + real, intent(out) :: A(:,:,:) !< First component of rotated vector [arbitrary] + real, intent(out) :: B(:,:,:) !< Second component of unrotated vector [arbitrary] integer :: k @@ -261,11 +261,11 @@ end subroutine rotate_vector_real_3d !> Rotate the elements of a 4d real vector along first and second axes. subroutine rotate_vector_real_4d(A_in, B_in, turns, A, B) - real, intent(in) :: A_in(:,:,:,:) !< First component of unrotated vector - real, intent(in) :: B_in(:,:,:,:) !< Second component of unrotated vector + real, intent(in) :: A_in(:,:,:,:) !< First component of unrotated vector [arbitrary] + real, intent(in) :: B_in(:,:,:,:) !< Second component of unrotated vector [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, intent(out) :: A(:,:,:,:) !< First component of rotated vector - real, intent(out) :: B(:,:,:,:) !< Second component of unrotated vector + real, intent(out) :: A(:,:,:,:) !< First component of rotated vector [arbitrary] + real, intent(out) :: B(:,:,:,:) !< Second component of unrotated vector [arbitrary] integer :: n @@ -280,9 +280,9 @@ end subroutine rotate_vector_real_4d subroutine allocate_rotated_array_real_2d(A_in, lb, turns, A) ! NOTE: lb must be declared before A_in integer, intent(in) :: lb(2) !< Lower index bounds of A_in - real, intent(in) :: A_in(lb(1):, lb(2):) !< Reference array + real, intent(in) :: A_in(lb(1):, lb(2):) !< Reference array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, allocatable, intent(inout) :: A(:,:) !< Array on rotated index + real, allocatable, intent(inout) :: A(:,:) !< Array on rotated index [arbitrary] integer :: ub(2) @@ -300,9 +300,9 @@ end subroutine allocate_rotated_array_real_2d subroutine allocate_rotated_array_real_3d(A_in, lb, turns, A) ! NOTE: lb must be declared before A_in integer, intent(in) :: lb(3) !< Lower index bounds of A_in - real, intent(in) :: A_in(lb(1):, lb(2):, lb(3):) !< Reference array + real, intent(in) :: A_in(lb(1):, lb(2):, lb(3):) !< Reference array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, allocatable, intent(inout) :: A(:,:,:) !< Array on rotated index + real, allocatable, intent(inout) :: A(:,:,:) !< Array on rotated index [arbitrary] integer :: ub(3) @@ -320,9 +320,9 @@ end subroutine allocate_rotated_array_real_3d subroutine allocate_rotated_array_real_4d(A_in, lb, turns, A) ! NOTE: lb must be declared before A_in integer, intent(in) :: lb(4) !< Lower index bounds of A_in - real, intent(in) :: A_in(lb(1):,lb(2):,lb(3):,lb(4):) !< Reference array + real, intent(in) :: A_in(lb(1):,lb(2):,lb(3):,lb(4):) !< Reference array [arbitrary] integer, intent(in) :: turns !< Number of quarter turns - real, allocatable, intent(inout) :: A(:,:,:,:) !< Array on rotated index + real, allocatable, intent(inout) :: A(:,:,:,:) !< Array on rotated index [arbitrary] integer:: ub(4) diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index aae3d3f5dc..00e4ba4918 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -21,6 +21,13 @@ module MOM_checksums public :: hchksum_pair, uvchksum, Bchksum_pair public :: MOM_checksums_init +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + !> Checksums a pair of arrays (2d or 3d) staggered at tracer points interface hchksum_pair module procedure chksum_pair_h_2d, chksum_pair_h_3d @@ -96,14 +103,20 @@ module MOM_checksums !> Checksum a scalar field (consistent with array checksums) subroutine chksum0(scalar, mesg, scale, logunit) - real, intent(in) :: scalar !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message - real, optional, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scalar !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real :: scaling !< Explicit rescaling factor + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real :: scaling !< Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit - real :: rs !< Rescaled scalar + real :: rs !< Rescaled scalar [a] integer :: bc !< Scalar bitcount if (checkForNaNs .and. is_NaN(scalar)) & @@ -129,16 +142,22 @@ end subroutine chksum0 !> Checksum a 1d array (typically a column). subroutine zchksum(array, mesg, scale, logunit) - real, dimension(:), intent(in) :: array !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, dimension(:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, allocatable, dimension(:) :: rescaled_array - real :: scaling + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, allocatable, dimension(:) :: rescaled_array ! The array with scaling undone [a] + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: k - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0 if (checkForNaNs) then @@ -174,8 +193,10 @@ subroutine zchksum(array, mesg, scale, logunit) contains integer function subchk(array, scale) - real, dimension(:), intent(in) :: array !< The array to be checksummed - real, intent(in) :: scale !< A scaling factor for this array. + real, dimension(:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: k, bc subchk = 0 do k=LBOUND(array, 1), UBOUND(array, 1) @@ -186,10 +207,10 @@ integer function subchk(array, scale) end function subchk subroutine subStats(array, aMean, aMin, aMax) - real, dimension(:), intent(in) :: array !< The array to be checksummed - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, dimension(:), intent(in) :: array !< The array to be checksummed [a] + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: k, n @@ -210,18 +231,21 @@ subroutine chksum_pair_h_2d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, & scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert these arrays back to unscaled + !! units for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -261,19 +285,21 @@ subroutine chksum_pair_h_3d(mesg, arrayA, arrayB, HI, haloshift, omit_corners, & scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%jsd:, :), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging - - logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging + logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -312,21 +338,27 @@ end subroutine chksum_pair_h_3d !> Checksums a 2d array staggered at tracer points. subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logunit) - type(hor_index_type), target, intent(in) :: HI_m !< Horizontal index bounds of the model grid - real, dimension(HI_m%isd:,HI_m%jsd:), target, intent(in) :: array_m !< Field array on the model grid - character(len=*), intent(in) :: mesg !< An identifying message + type(hor_index_type), target, intent(in) :: HI_m !< Horizontal index bounds of the model grid + real, dimension(HI_m%isd:,HI_m%jsd:), target, intent(in) :: array_m !< Field array on the model grid in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners @@ -415,10 +447,12 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu contains integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di @@ -431,10 +465,10 @@ end function subchk subroutine subStats(HI, array, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, dimension(HI%isd:,HI%jsd:), intent(in) :: array !< The array to be checksummed [a] + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n @@ -460,22 +494,25 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%jsd:), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: sym logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -520,21 +557,24 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayA !< The first array to be checksummed - real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayB !< The second array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayA !< The first array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%IsdB:,HI%JsdB:, :), target, intent(in) :: arrayB !< The second array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in + real, dimension(:,:,:), pointer :: arrayA_in, arrayB_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -576,22 +616,28 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type real, dimension(HI_m%IsdB:,HI_m%JsdB:), & - target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the !! full symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, Is, Js - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -692,10 +738,12 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -709,12 +757,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n, IsB, JsB @@ -742,20 +790,23 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:), target, intent(in) :: arrayU !< The u-component array to be checksummed - real, dimension(HI%isd:,HI%JsdB:), target, intent(in) :: arrayV !< The v-component array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:), target, intent(in) :: arrayU !< The u-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%JsdB:), target, intent(in) :: arrayV !< The v-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for these arrays. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert these arrays back to unscaled + !! units for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe a - !! a scalar, rather than vector + !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:), pointer :: arrayU_in, arrayV_in + real, dimension(:,:), pointer :: arrayU_in, arrayV_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -797,20 +848,23 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, & omit_corners, scale, logunit, scalar_pair) character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), target, intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:,:), target, intent(in) :: arrayU !< The u-component array to be checksummed - real, dimension(HI%isd:,HI%JsdB:,:), target, intent(in) :: arrayV !< The v-component array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:,:), target, intent(in) :: arrayU !< The u-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + real, dimension(HI%isd:,HI%JsdB:,:), target, intent(in) :: arrayV !< The v-component array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for these arrays. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert these arrays back to unscaled + !! units for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging logical, optional, intent(in) :: scalar_pair !< If true, then the arrays describe a !! a scalar, rather than vector logical :: vector_pair integer :: turns type(hor_index_type), pointer :: HI_in - real, dimension(:,:,:), pointer :: arrayU_in, arrayV_in + real, dimension(:,:,:), pointer :: arrayU_in, arrayV_in ! Rotated arrays [A ~> a] vector_pair = .true. if (present(scalar_pair)) vector_pair = .not. scalar_pair @@ -850,23 +904,29 @@ end subroutine chksum_uv_3d !> Checksums a 2d array staggered at C-grid u points. subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) - type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%IsdB:,HI_m%jsd:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type + real, dimension(HI_m%IsdB:,HI_m%jsd:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, Is - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -981,10 +1041,12 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -998,12 +1060,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n, IsB @@ -1029,22 +1091,28 @@ end subroutine chksum_u_2d subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isd:,HI_m%JsdB:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%isd:,HI_m%JsdB:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:) ! Field array on the input grid - real, allocatable, dimension(:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, Js - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1159,10 +1227,12 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1176,12 +1246,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, n, JsB @@ -1206,20 +1276,26 @@ end subroutine chksum_v_2d !> Checksums a 3d array staggered at tracer points. subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isd:,HI_m%jsd:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%isd:,HI_m%jsd:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners @@ -1311,10 +1387,12 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 do k=LBOUND(array,3),UBOUND(array,3) ; do j=HI%jsc+dj,HI%jec+dj ; do i=HI%isc+di,HI%iec+di @@ -1327,10 +1405,10 @@ end function subchk subroutine subStats(HI, array, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, dimension(HI%isd:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed [a] + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, k, n @@ -1355,22 +1433,28 @@ end subroutine chksum_h_3d subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%IsdB:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%IsdB:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k, Is, Js - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1478,10 +1562,12 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1495,12 +1581,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, k, n, IsB, JsB @@ -1526,22 +1612,28 @@ end subroutine chksum_B_3d subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isdB:,HI_m%Jsd:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + real, dimension(HI_m%isdB:,HI_m%Jsd:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k, Is - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW logical :: do_corners, sym, sym_stats @@ -1656,10 +1748,12 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1673,12 +1767,12 @@ end function subchk subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Array mean - real, intent(out) :: aMin !< Array minimum - real, intent(out) :: aMax !< Array maximum + real, intent(out) :: aMean !< Array mean [a] + real, intent(out) :: aMin !< Array minimum [a] + real, intent(out) :: aMax !< Array maximum [a] integer :: i, j, k, n, IsB @@ -1703,25 +1797,31 @@ end subroutine chksum_u_3d !> Checksums a 3d array staggered at C-grid v points. subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, & scale, logunit) - type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type - real, dimension(HI_m%isd:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed - character(len=*), intent(in) :: mesg !< An identifying message + type(hor_index_type), target, intent(in) :: HI_m !< A horizontal index type + real, dimension(HI_m%isd:,HI_m%JsdB:,:), target, intent(in) :: array_m !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] + character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts - real, optional, intent(in) :: scale !< A scaling factor for this array. - integer, optional, intent(in) :: logunit !< IO unit for checksum logging + real, optional, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] + integer, optional, intent(in) :: logunit !< IO unit for checksum logging - real, pointer :: array(:,:,:) ! Field array on the input grid - real, allocatable, dimension(:,:,:) :: rescaled_array + ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units + ! of the input array while [a] indicates the unscaled (e.g., mks) units that should be used + ! for checksums and output + real, pointer :: array(:,:,:) ! Field array on the input grid [A ~> a] + real, allocatable, dimension(:,:,:) :: rescaled_array ! The array with scaling undone [a] type(hor_index_type), pointer :: HI ! Horizontal index bounds of the input grid - real :: scaling + real :: scaling ! Explicit rescaling factor [a A-1 ~> 1] integer :: iounit !< Log IO unit integer :: i, j, k, Js integer :: bc0, bcSW, bcSE, bcNW, bcNE, hshift integer :: bcN, bcS, bcE, bcW - real :: aMean, aMin, aMax + real :: aMean, aMin, aMax ! Array mean, global minimum and global maximum [a] logical :: do_corners, sym, sym_stats integer :: turns ! Quarter turns from input to model grid @@ -1834,10 +1934,12 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, integer function subchk(array, HI, di, dj, scale) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed in + !! arbitrary, possibly rescaled units [A ~> a] integer, intent(in) :: di !< i- direction array shift for this checksum integer, intent(in) :: dj !< j- direction array shift for this checksum - real, intent(in) :: scale !< A scaling factor for this array. + real, intent(in) :: scale !< A factor to convert this array back to unscaled units + !! for checksums and output [a A-1 ~> 1] integer :: i, j, k, bc subchk = 0 ! This line deliberately uses the h-point computational domain. @@ -1852,12 +1954,12 @@ end function subchk !subroutine subStats(HI, array, mesg, sym_stats) subroutine subStats(HI, array, sym_stats, aMean, aMin, aMax) type(hor_index_type), intent(in) :: HI !< A horizontal index type - real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed + real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed [a] logical, intent(in) :: sym_stats !< If true, evaluate the statistics on the !! full symmetric computational domain. - real, intent(out) :: aMean !< Mean of array over domain - real, intent(out) :: aMin !< Minimum of array over domain - real, intent(out) :: aMax !< Maximum of array over domain + real, intent(out) :: aMean !< Mean of array over domain [a] + real, intent(out) :: aMin !< Minimum of array over domain [a] + real, intent(out) :: aMax !< Maximum of array over domain [a] integer :: i, j, k, n, JsB @@ -1884,7 +1986,7 @@ end subroutine chksum_v_3d !> chksum1d does a checksum of a 1-dimensional array. subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) - real, dimension(:), intent(in) :: array !< The array to be summed (index starts at 1). + real, dimension(:), intent(in) :: array !< The array to be summed (index starts at 1) [abitrary]. character(len=*), intent(in) :: mesg !< An identifying message. integer, optional, intent(in) :: start_i !< The starting index for the sum (default 1) integer, optional, intent(in) :: end_i !< The ending index for the sum (default all) @@ -1892,8 +1994,8 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) !! and list the root_PE value (default true) integer :: is, ie, i, bc, sum1, sum_bc - real :: sum - real, allocatable :: sum_here(:) + real :: sum ! The global sum of the array [arbitrary] + real, allocatable :: sum_here(:) ! The sum on each PE [arbitrary] logical :: compare integer :: pe_num ! pe number of the data integer :: nPEs ! Total number of processsors @@ -1943,11 +2045,11 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg) - real, dimension(:,:), intent(in) :: array !< The array to be checksummed + real, dimension(:,:), intent(in) :: array !< The array to be checksummed [arbitrary] character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,i,j,sum1,bc - real :: sum + real :: sum ! The global sum of the array [arbitrary] xs = LBOUND(array,1) ; xe = UBOUND(array,1) ys = LBOUND(array,2) ; ye = UBOUND(array,2) @@ -1971,11 +2073,11 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg) - real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed + real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed [arbitrary] character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 - real :: sum + real :: sum ! The global sum of the array [arbitrary] xs = LBOUND(array,1) ; xe = UBOUND(array,1) ys = LBOUND(array,2) ; ye = UBOUND(array,2) @@ -1999,7 +2101,7 @@ end subroutine chksum3d !> This function returns .true. if x is a NaN, and .false. otherwise. function is_NaN_0d(x) - real, intent(in) :: x !< The value to be checked for NaNs. + real, intent(in) :: x !< The value to be checked for NaNs [arbitrary] logical :: is_NaN_0d !is_NaN_0d = (((x < 0.0) .and. (x >= 0.0)) .or. & @@ -2015,7 +2117,7 @@ end function is_NaN_0d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) - real, dimension(:), intent(in) :: x !< The array to be checked for NaNs. + real, dimension(:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] logical, optional, intent(in) :: skip_mpp !< If true, only check this array only !! on the local PE (default false). logical :: is_NaN_1d @@ -2038,7 +2140,7 @@ end function is_NaN_1d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_2d(x) - real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs. + real, dimension(:,:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] logical :: is_NaN_2d integer :: i, j, n @@ -2055,7 +2157,7 @@ end function is_NaN_2d !> Returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_3d(x) - real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs. + real, dimension(:,:,:), intent(in) :: x !< The array to be checked for NaNs [arbitrary] logical :: is_NaN_3d integer :: i, j, k, n @@ -2078,9 +2180,9 @@ end function is_NaN_3d !> Compute the field checksum of a scalar. function rotated_field_chksum_real_0d(field, pelist, mask_val, turns) & result(chksum) - real, intent(in) :: field !< Input scalar + real, intent(in) :: field !< Input scalar [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of scalar @@ -2093,9 +2195,9 @@ end function rotated_field_chksum_real_0d !> Compute the field checksum of a 1d field. function rotated_field_chksum_real_1d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:), intent(in) :: field !< Input array + real, dimension(:), intent(in) :: field !< Input array [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array @@ -2108,14 +2210,14 @@ end function rotated_field_chksum_real_1d !> Compute the field checksum of a rotated 2d field. function rotated_field_chksum_real_2d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:,:), intent(in) :: field !< Unrotated input field + real, dimension(:,:), intent(in) :: field !< Unrotated input field [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [arbitrary] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 @@ -2135,14 +2237,14 @@ end function rotated_field_chksum_real_2d !> Compute the field checksum of a rotated 3d field. function rotated_field_chksum_real_3d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:,:,:), intent(in) :: field !< Unrotated input field + real, dimension(:,:,:), intent(in) :: field !< Unrotated input field [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [arbitrary] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 @@ -2162,14 +2264,14 @@ end function rotated_field_chksum_real_3d !> Compute the field checksum of a rotated 4d field. function rotated_field_chksum_real_4d(field, pelist, mask_val, turns) & result(chksum) - real, dimension(:,:,:,:), intent(in) :: field !< Unrotated input field + real, dimension(:,:,:,:), intent(in) :: field !< Unrotated input field [arbitrary] integer, optional, intent(in) :: pelist(:) !< PE list of ranks to checksum - real, optional, intent(in) :: mask_val !< FMS mask value + real, optional, intent(in) :: mask_val !< FMS mask value [nondim] integer, optional, intent(in) :: turns !< Number of quarter turns integer(kind=int64) :: chksum !< checksum of array ! Local variables - real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [arbitrary] integer :: qturns ! The number of quarter turns through which to rotate field qturns = 0 @@ -2268,9 +2370,9 @@ end subroutine chk_sum_msg2 subroutine chk_sum_msg3(fmsg, aMean, aMin, aMax, mesg, iounit) character(len=*), intent(in) :: fmsg !< A checksum code-location specific preamble character(len=*), intent(in) :: mesg !< An identifying message supplied by top-level caller - real, intent(in) :: aMean !< The mean value of the array - real, intent(in) :: aMin !< The minimum value of the array - real, intent(in) :: aMax !< The maximum value of the array + real, intent(in) :: aMean !< The mean value of the array [arbitrary] + real, intent(in) :: aMin !< The minimum value of the array [arbitrary] + real, intent(in) :: aMax !< The maximum value of the array [arbitrary] integer, intent(in) :: iounit !< Checksum logger IO unit ! NOTE: We add zero to aMin and aMax to remove any negative zeros. @@ -2284,8 +2386,8 @@ end subroutine chk_sum_msg3 !! only thing that it does is to log the version of this module. subroutine MOM_checksums_init(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! 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_checksums" ! This module's name. call log_version(param_file, mdl, version) @@ -2303,7 +2405,7 @@ end subroutine chksum_error !> Does a bitcount of a number by first casting to an integer and then using BTEST !! to check bit by bit integer function bitcount(x) - real, intent(in) :: x !< Number to be bitcount + real, intent(in) :: x !< Number to be bitcount [arbitrary] integer, parameter :: xk = kind(x) !< Kind type of x diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index fbfd4e3976..092b12a2d2 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3228,7 +3228,7 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) call get_param(param_file, mdl, 'DIAG_MISVAL', diag_cs%missing_value, & 'Set the default missing value to use for diagnostics.', & - default=1.e20) + units="various", default=1.e20) call get_param(param_file, mdl, 'DIAG_AS_CHKSUM', diag_cs%diag_as_chksum, & 'Instead of writing diagnostics to the diag manager, write '//& 'a text file containing the checksum (bitcount) of the array.', & diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90 index 1bdf13b41f..ff0eda6325 100644 --- a/src/framework/MOM_diag_remap.F90 +++ b/src/framework/MOM_diag_remap.F90 @@ -62,15 +62,14 @@ module MOM_diag_remap use MOM_error_handler, only : MOM_error, FATAL, assert, WARNING use MOM_debugging, only : check_column_integrals use MOM_diag_manager_infra,only : MOM_diag_axis_init -use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_file_parser, only : get_param, log_param, param_file_type use MOM_string_functions, only : lowercase, extractWord use MOM_grid, only : ocean_grid_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : EOS_type -use MOM_remapping, only : remapping_CS, initialize_remapping -use MOM_remapping, only : remapping_core_h +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_remapping, only : interpolate_column, reintegrate_column use MOM_regridding, only : regridding_CS, initialize_regridding use MOM_regridding, only : end_regridding use MOM_regridding, only : set_regrid_params, get_regrid_size @@ -328,10 +327,6 @@ subroutine diag_remap_update(remap_cs, G, GV, US, h, T, S, eqn_of_state, h_targe call build_rho_column(get_rho_CS(remap_cs%regrid_cs), GV%ke, & 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)+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)+G%Z_ref), sum(h(i,j,:)), zInterfaces) @@ -528,7 +523,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (h_target(i_lo,j,:) + h_target(i_hi,j,:)) call reintegrate_column(nz_src, h_src, field(I1,j,:), & - nz_dest, h_dest, 0., reintegrated_field(I1,j,:)) + nz_dest, h_dest, reintegrated_field(I1,j,:)) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then @@ -543,7 +538,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (h_target(i,j_lo,:) + h_target(i,j_hi,:)) call reintegrate_column(nz_src, h_src, field(i,J1,:), & - nz_dest, h_dest, 0., reintegrated_field(i,J1,:)) + nz_dest, h_dest, reintegrated_field(i,J1,:)) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -556,7 +551,7 @@ subroutine vertically_reintegrate_diag_field(remap_cs, G, h, h_target, staggered h_src(:) = h(i,j,:) h_dest(:) = h_target(i,j,:) call reintegrate_column(nz_src, h_src, field(i,j,:), & - nz_dest, h_dest, 0., reintegrated_field(i,j,:)) + nz_dest, h_dest, reintegrated_field(i,j,:)) enddo enddo else @@ -609,7 +604,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = 0.5 * (h(i_lo,j,:) + h(i_hi,j,:)) h_dest(:) = 0.5 * (remap_cs%h(i_lo,j,:) + remap_cs%h(i_hi,j,:)) call interpolate_column(nz_src, h_src, field(I1,j,:), & - nz_dest, h_dest, 0., interpolated_field(I1,j,:)) + nz_dest, h_dest, interpolated_field(I1,j,:), .true.) enddo enddo elseif (staggered_in_y .and. .not. staggered_in_x) then @@ -624,7 +619,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = 0.5 * (h(i,j_lo,:) + h(i,j_hi,:)) h_dest(:) = 0.5 * (remap_cs%h(i,j_lo,:) + remap_cs%h(i,j_hi,:)) call interpolate_column(nz_src, h_src, field(i,J1,:), & - nz_dest, h_dest, 0., interpolated_field(i,J1,:)) + nz_dest, h_dest, interpolated_field(i,J1,:), .true.) enddo enddo elseif ((.not. staggered_in_x) .and. (.not. staggered_in_y)) then @@ -637,7 +632,7 @@ subroutine vertically_interpolate_diag_field(remap_cs, G, h, staggered_in_x, sta h_src(:) = h(i,j,:) h_dest(:) = remap_cs%h(i,j,:) call interpolate_column(nz_src, h_src, field(i,j,:), & - nz_dest, h_dest, 0., interpolated_field(i,j,:)) + nz_dest, h_dest, interpolated_field(i,j,:), .true.) enddo enddo else diff --git a/src/framework/MOM_diag_vkernels.F90 b/src/framework/MOM_diag_vkernels.F90 deleted file mode 100644 index 886f6dcd4d..0000000000 --- a/src/framework/MOM_diag_vkernels.F90 +++ /dev/null @@ -1,357 +0,0 @@ -!> Provides kernels for single-column interpolation, re-integration (re-mapping of integrated quantities) -!! and intensive-variable remapping in the vertical -module MOM_diag_vkernels - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_io, only : stdout, stderr - -implicit none ; private - -public diag_vkernels_unit_tests -public interpolate_column -public reintegrate_column - -contains - -!> Linearly interpolate interface data, u_src, from grid h_src to a grid h_dest -subroutine interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, intent(in) :: missing_value !< Value to assign in vanished cells - real, dimension(ndest+1), intent(inout) :: u_dest !< Interpolated value at destination cell interfaces - ! Local variables - real :: x_dest ! Relative position of target interface - real :: dh ! Source cell thickness - real :: u1, u2 ! Values to interpolate between - real :: weight_a, weight_b ! Weights for interpolation - integer :: k_src, k_dest ! Index of cell in src and dest columns - logical :: still_vanished ! Used for figuring out what to mask as missing - - ! Initial values for the loop - still_vanished = .true. - - ! The following forces the "do while" loop to do one cycle that will set u1, u2, dh. - k_src = 0 - dh = 0. - x_dest = 0. - - do k_dest=1, ndest+1 - do while (dh<=x_dest .and. k_src0.) then - weight_a = max(0., ( dh - x_dest ) / dh) ! Weight of u1 - weight_b = min(1., x_dest / dh) ! Weight of u2 - u_dest(k_dest) = weight_a * u1 + weight_b * u2 ! Linear interpolation between u1 and u2 - else - u_dest(k_dest) = 0.5 * ( u1 + u2 ) ! For a vanished layer we need to do something reasonable... - endif - - ! Mask vanished layers at the surface which would be under an ice-shelf. - ! TODO: Need to figure out what to do for an isopycnal coordinate diagnostic that could - ! also have vanished layers at the surface. - if (k_dest<=ndest) then - x_dest = x_dest + h_dest(k_dest) ! Position of interface k_dest+1 - if (still_vanished .and. h_dest(k_dest)==0.) then - ! When the layer k_dest is vanished and all layers above are also vanished, the k_dest - ! interface value should be missing. - u_dest(k_dest) = missing_value - else - still_vanished = .false. - endif - endif - - enddo - - ! Mask vanished layers on topography - still_vanished = .true. - do k_dest=ndest, 1, -1 - if (still_vanished .and. h_dest(k_dest)==0.) then - ! When the layer k_dest is vanished and all layers below are also vanished, the k_dest+1 - ! interface value should be missing. - u_dest(k_dest+1) = missing_value - else - exit - endif - enddo - -end subroutine interpolate_column - -!> Conservatively calculate integrated data, uh_dest, on grid h_dest, from layer-integrated data, uh_src, on grid h_src -subroutine reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc), intent(in) :: uh_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, intent(in) :: missing_value !< Value to assign in vanished cells - real, dimension(ndest), intent(inout) :: uh_dest !< Interpolated value at destination cell interfaces - - ! Local variables - real :: h_src_rem, h_dest_rem, dh ! Incremental thicknesses - real :: uh_src_rem, duh ! Incremental amounts of stuff - integer :: k_src, k_dest ! Index of cell in src and dest columns - logical :: src_ran_out, src_exists - - uh_dest(:) = missing_value - - k_src = 0 - k_dest = 0 - h_dest_rem = 0. - h_src_rem = 0. - src_ran_out = .false. - src_exists = .false. - - do while(.true.) - if (h_src_rem==0. .and. k_src0.) duh = uh_src_rem - h_src_rem = 0. - uh_src_rem = 0. - h_dest_rem = max(0., h_dest_rem - dh) - elseif (h_src_rem>h_dest_rem) then - ! Only part of the source cell can be used up - dh = h_dest_rem - duh = (dh / h_src_rem) * uh_src_rem - h_src_rem = max(0., h_src_rem - dh) - uh_src_rem = uh_src_rem - duh - h_dest_rem = 0. - else ! h_src_rem==h_dest_rem - ! The source cell exactly fits the destination cell - duh = uh_src_rem - h_src_rem = 0. - uh_src_rem = 0. - h_dest_rem = 0. - endif - uh_dest(k_dest) = uh_dest(k_dest) + duh - if (k_dest==ndest .and. (k_src==nsrc .or. h_dest_rem==0.)) exit - enddo - - if (.not. src_exists) uh_dest(1:ndest) = missing_value - -end subroutine reintegrate_column - -!> Returns true if any unit tests for module MOM_diag_vkernels fail -logical function diag_vkernels_unit_tests(verbose) - logical, intent(in) :: verbose !< If true, write results to stdout - ! Local variables - real, parameter :: mv=-9.999999999E9 ! Value to use for vanished layers - logical :: fail, v - - v = verbose - - write(stdout,*) '==== MOM_diag_kernels: diag_vkernels_unit_tests ==========' - if (v) write(stdout,*) '- - - - - - - - - - interpolation tests - - - - - - - - -' - - fail = test_interp(v,mv,'Identity: 3 layer', & - 3, (/1.,2.,3./), (/1.,2.,3.,4./), & - 3, (/1.,2.,3./), (/1.,2.,3.,4./) ) - diag_vkernels_unit_tests = fail - - fail = test_interp(v,mv,'A: 3 layer to 2', & - 3, (/1.,1.,1./), (/1.,2.,3.,4./), & - 2, (/1.5,1.5/), (/1.,2.5,4./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'B: 2 layer to 3', & - 2, (/1.5,1.5/), (/1.,4.,7./), & - 3, (/1.,1.,1./), (/1.,3.,5.,7./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'C: 3 layer (vanished middle) to 2', & - 3, (/1.,0.,2./), (/1.,2.,2.,3./), & - 2, (/1.,2./), (/1.,2.,3./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'D: 3 layer (deep) to 3', & - 3, (/1.,2.,3./), (/1.,2.,4.,7./), & - 2, (/2.,2./), (/1.,3.,5./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'E: 3 layer to 3 (deep)', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 3, (/2.,3.,4./), (/1.,3.,6.,8./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'F: 3 layer to 4 with vanished top/botton', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,5.,0./), (/mv,1.,3.,8.,mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'Fs: 3 layer to 4 with vanished top/botton (shallow)', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,4.,0./), (/mv,1.,3.,7.,mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_interp(v,mv,'Fd: 3 layer to 4 with vanished top/botton (deep)', & - 3, (/1.,2.,4./), (/1.,2.,4.,8./), & - 4, (/0.,2.,6.,0./), (/mv,1.,3.,8.,mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - if (v) write(stdout,*) '- - - - - - - - - - reintegration tests - - - - - - - - -' - - fail = test_reintegrate(v,mv,'Identity: 3 layer', & - 3, (/1.,2.,3./), (/-5.,2.,1./), & - 3, (/1.,2.,3./), (/-5.,2.,1./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'A: 3 layer to 2', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 2, (/3.,3./), (/-4.,2./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'A: 3 layer to 2 (deep)', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 2, (/3.,4./), (/-4.,2./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'A: 3 layer to 2 (shallow)', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 2, (/3.,2./), (/-4.,1.5/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'B: 3 layer to 4 with vanished top/bottom', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 4, (/0.,3.,3.,0./), (/0.,-4.,2.,0./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'C: 3 layer to 4 with vanished top//middle/bottom', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 5, (/0.,3.,0.,3.,0./), (/0.,-4.,0.,2.,0./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer to 3 (vanished)', & - 3, (/2.,2.,2./), (/-5.,2.,1./), & - 3, (/0.,0.,0./), (/0.,0.,0./) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3', & - 3, (/0.,0.,0./), (/-5.,2.,1./), & - 3, (/2.,2.,2./), (/mv, mv, mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & - 3, (/0.,0.,0./), (/-5.,2.,1./), & - 3, (/0.,0.,0./), (/mv, mv, mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - fail = test_reintegrate(v,mv,'D: 3 layer (vanished) to 3 (vanished)', & - 3, (/0.,0.,0./), (/0.,0.,0./), & - 3, (/0.,0.,0./), (/mv, mv, mv/) ) - diag_vkernels_unit_tests = diag_vkernels_unit_tests .or. fail - - if (.not. fail) write(stdout,*) 'Pass' - -end function diag_vkernels_unit_tests - -!> Returns true if a test of interpolate_column() produces the wrong answer -logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, ndest, h_dest, u_true) - logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: missing_value !< Value to indicate missing data - character(len=*), intent(in) :: msg !< Message to label test - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc+1), intent(in) :: u_src !< Values at source cell interfaces - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, dimension(ndest+1), intent(in) :: u_true !< Correct value at destination cell interfaces - ! Local variables - real, dimension(ndest+1) :: u_dest ! Interpolated value at destination cell interfaces - integer :: k - real :: error - - ! Interpolate from src to dest - call interpolate_column(nsrc, h_src, u_src, ndest, h_dest, missing_value, u_dest) - - test_interp = .false. - do k=1,ndest+1 - if (u_dest(k)/=u_true(k)) test_interp = .true. - enddo - if (verbose .or. test_interp) then - write(stdout,'(2a)') ' Test: ',msg - write(stdout,'(a3,3(a24))') 'k','u_result','u_true','error' - do k=1,ndest+1 - error = u_dest(k)-u_true(k) - if (error==0.) then - write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) - else - write(stdout,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' - write(stderr,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' - endif - enddo - endif -end function test_interp - -!> Returns true if a test of reintegrate_column() produces the wrong answer -logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_src, ndest, h_dest, uh_true) - logical, intent(in) :: verbose !< If true, write results to stdout - real, intent(in) :: missing_value !< Value to indicate missing data - character(len=*), intent(in) :: msg !< Message to label test - integer, intent(in) :: nsrc !< Number of source cells - real, dimension(nsrc), intent(in) :: h_src !< Thickness of source cells - real, dimension(nsrc), intent(in) :: uh_src !< Values of source cell stuff - integer, intent(in) :: ndest !< Number of destination cells - real, dimension(ndest), intent(in) :: h_dest !< Thickness of destination cells - real, dimension(ndest), intent(in) :: uh_true !< Correct value of destination cell stuff - ! Local variables - real, dimension(ndest) :: uh_dest ! Reintegrated value on destination cells - integer :: k - real :: error - - ! Interpolate from src to dest - call reintegrate_column(nsrc, h_src, uh_src, ndest, h_dest, missing_value, uh_dest) - - test_reintegrate = .false. - do k=1,ndest - if (uh_dest(k)/=uh_true(k)) test_reintegrate = .true. - enddo - if (verbose .or. test_reintegrate) then - write(stdout,'(2a)') ' Test: ',msg - write(stdout,'(a3,3(a24))') 'k','uh_result','uh_true','error' - do k=1,ndest - error = uh_dest(k)-uh_true(k) - if (error==0.) then - write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) - else - write(stdout,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' - write(stderr,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' - endif - enddo - endif -end function test_reintegrate - -end module MOM_diag_vkernels diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index a68a725feb..f32573815f 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -637,19 +637,33 @@ function real_string(val) elseif (val == 0.) then real_string = "0.0" else - if ((abs(val) <= 1.0e-100) .or. (abs(val) >= 1.0e100)) then - write(real_string(1:32), '(ES24.14E3)') val - if (.not.testFormattedFloatIsReal(real_string,val)) & - write(real_string(1:32), '(ES24.15E3)') val + if ((abs(val) < 1.0e-99) .or. (abs(val) >= 1.0e100)) then + write(real_string(1:32), '(ES24.14E4)') val + if (scan(real_string, "eE") == 0) then ! Fix a bug with a missing E in PGI formatting + ind = scan(real_string, "-+", back=.true.) + if (ind > index(real_string, ".") ) & ! Avoid changing a leading sign. + real_string = real_string(1:ind-1)//"E"//real_string(ind:) + endif + if (.not.testFormattedFloatIsReal(real_string, val)) then + write(real_string(1:32), '(ES25.15E4)') val + if (scan(real_string, "eE") == 0) then ! Fix a bug with a missing E in PGI formatting + ind = scan(real_string, "-+", back=.true.) + if (ind > index(real_string, ".") ) & ! Avoid changing a leading sign. + real_string = real_string(1:ind-1)//"E"//real_string(ind:) + endif + endif + ! Remove a leading 0 from the exponent, if it is there. + ind = max(index(real_string, "E+0"), index(real_string, "E-0")) + if (ind > 0) real_string = real_string(1:ind+1)//real_string(ind+3:) else write(real_string(1:32), '(ES23.14)') val - if (.not.testFormattedFloatIsReal(real_string,val)) & + if (.not.testFormattedFloatIsReal(real_string, val)) & write(real_string(1:32), '(ES23.15)') val endif - do - ind = index(real_string,"0E") + do ! Remove extra trailing 0s before the exponent. + ind = index(real_string, "0E") if (ind == 0) exit - if (real_string(ind-1:ind-1) == ".") exit + if (real_string(ind-1:ind-1) == ".") exit ! Leave at least one digit after the decimal point. real_string = real_string(1:ind-1)//real_string(ind+1:) enddo endif diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 47ac43df06..a0f3855d19 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -180,7 +180,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & !$ if (.not.MOM_thread_affinity_set()) then !$ call get_param(param_file, mdl, "OCEAN_OMP_THREADS", ocean_nthreads, & !$ "The number of OpenMP threads that MOM6 will use.", & - !$ default = 1, layoutParam=.true.) + !$ default=1, layoutParam=.true.) !$ call get_param(param_file, mdl, "OCEAN_OMP_HYPER_THREAD", ocean_omp_hyper_thread, & !$ "If True, use hyper-threading.", default=.false., layoutParam=.true.) !$ call set_MOM_thread_affinity(ocean_nthreads, ocean_omp_hyper_thread) diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 60c30d8e94..8c163f710f 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -145,9 +145,12 @@ module MOM_dyn_horgrid !< The longitude of B points for the purpose of labeling the output axes. !! On many grids this is the same as geoLonBu. character(len=40) :: & + ! Except on a Cartesian grid, these are usually some variant of "degrees". x_axis_units, & !< The units that are used in labeling the x coordinate axes. - y_axis_units !< The units that are used in labeling the y coordinate axes. - ! Except on a Cartesian grid, these are usually some variant of "degrees". + y_axis_units, & !< The units that are used in labeling the y coordinate axes. + ! These are internally generated names, including "m", "km", "deg_E" and "deg_N". + x_ax_unit_short, & !< A short description of the x-axis units for documenting parameter units + y_ax_unit_short !< A short description of the y-axis units for documenting parameter units real, allocatable, dimension(:,:) :: & bathyT !< Ocean bottom depth at tracer points, in depth units [Z ~> m]. @@ -382,6 +385,8 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns) G%x_axis_units = G_in%y_axis_units G%y_axis_units = G_in%x_axis_units + G%x_ax_unit_short = G_in%y_ax_unit_short + G%y_ax_unit_short = G_in%x_ax_unit_short G%south_lat = G_in%south_lat G%west_lon = G_in%west_lon G%len_lat = G_in%len_lat diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index c85cccd9e2..5d658c44a4 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -1418,7 +1418,7 @@ end subroutine log_param_int_array !> Log the name and value of a real model parameter in documentation files. subroutine log_param_real(CS, modulename, varname, value, desc, units, & - default, debuggingParam, like_default) + default, debuggingParam, like_default, unscale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1432,26 +1432,31 @@ subroutine log_param_real(CS, modulename, varname, value, desc, units, & !! logged in the debugging parameter file logical, optional, intent(in) :: like_default !< If present and true, log this parameter as !! though it has the default value, even if there is no default. + real, optional, intent(in) :: unscale !< A reciprocal scaling factor that the parameter is + !! multiplied by before it is logged + real :: log_val ! The parameter value that is written out character(len=240) :: mesg, myunits + log_val = value ; if (present(unscale)) log_val = unscale * value + write(mesg, '(" ",a," ",a,": ",a)') & - trim(modulename), trim(varname), trim(left_real(value)) + trim(modulename), trim(varname), trim(left_real(log_val)) if (is_root_pe()) then if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg) if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg) endif - myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) + write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default, & + call doc_param(CS%doc, varname, desc, myunits, log_val, default, & debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_real !> Log the name and values of an array of real model parameter in documentation files. subroutine log_param_real_array(CS, modulename, varname, value, desc, & - units, default, debuggingParam, like_default) + units, default, debuggingParam, like_default, unscale) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1465,22 +1470,27 @@ subroutine log_param_real_array(CS, modulename, varname, value, desc, & !! logged in the debugging parameter file logical, optional, intent(in) :: like_default !< If present and true, log this parameter as !! though it has the default value, even if there is no default. + real, optional, intent(in) :: unscale !< A reciprocal scaling factor that the parameter is + !! multiplied by before it is logged + real, dimension(size(value)) :: log_val ! The array of parameter values that is written out character(len=:), allocatable :: mesg character(len=240) :: myunits + log_val(:) = value(:) ; if (present(unscale)) log_val(:) = unscale * value(:) + !write(mesg, '(" ",a," ",a,": ",ES19.12,99(",",ES19.12))') & !write(mesg, '(" ",a," ",a,": ",G,99(",",G))') & ! trim(modulename), trim(varname), value - mesg = " " // trim(modulename) // " " // trim(varname) // ": " // trim(left_reals(value)) + mesg = " " // trim(modulename) // " " // trim(varname) // ": " // trim(left_reals(log_val)) if (is_root_pe()) then if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg) if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg) endif - myunits="not defined"; if (present(units)) write(myunits(1:240),'(A)') trim(units) + write(myunits(1:240),'(A)') trim(units) if (present(desc)) & - call doc_param(CS%doc, varname, desc, myunits, value, default, & + call doc_param(CS%doc, varname, desc, myunits, log_val, default, & debuggingParam=debuggingParam, like_default=like_default) end subroutine log_param_real_array diff --git a/src/framework/MOM_hor_index.F90 b/src/framework/MOM_hor_index.F90 index 4e8cb2c43b..2ce2808692 100644 --- a/src/framework/MOM_hor_index.F90 +++ b/src/framework/MOM_hor_index.F90 @@ -63,7 +63,7 @@ module MOM_hor_index subroutine hor_index_init(Domain, HI, param_file, local_indexing, index_offset) type(MOM_domain_type), intent(in) :: Domain !< The MOM domain from which to extract information. type(hor_index_type), intent(inout) :: HI !< A horizontal index type to populate with data - type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(param_file_type), optional, intent(in) :: param_file !< Parameter file handle logical, optional, intent(in) :: local_indexing !< If true, all tracer data domains start at 1 integer, optional, intent(in) :: index_offset !< A fixed additional offset to all indices @@ -80,8 +80,9 @@ subroutine hor_index_init(Domain, HI, param_file, local_indexing, index_offset) call get_global_shape(Domain, HI%niglobal, HI%njglobal) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, "MOM_hor_index", version, & - "Sets the horizontal array index types.", all_default=.true.) + if (present(param_file)) & + call log_version(param_file, "MOM_hor_index", version, & + "Sets the horizontal array index types.", all_default=.true.) HI%IscB = HI%isc ; HI%JscB = HI%jsc HI%IsdB = HI%isd ; HI%JsdB = HI%jsd diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index bbb5ae0e15..83e7718311 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -5,6 +5,7 @@ module MOM_horizontal_regridding use MOM_debugging, only : hchksum use MOM_coms, only : max_across_PEs, min_across_PEs, sum_across_PEs, broadcast +use MOM_coms, only : reproducing_sum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_LOOP use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe @@ -24,7 +25,7 @@ module MOM_horizontal_regridding #include -public :: horiz_interp_and_extrap_tracer, myStats +public :: horiz_interp_and_extrap_tracer, myStats, homogenize_field !> Extrapolate and interpolate data interface horiz_interp_and_extrap_tracer @@ -32,22 +33,30 @@ module MOM_horizontal_regridding module procedure horiz_interp_and_extrap_tracer_fms_id end interface +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + contains !> Write to the terminal some basic statistics about the k-th level of an array subroutine myStats(array, missing, is, ie, js, je, k, mesg, scale) - real, dimension(:,:), intent(in) :: array !< input array [A] - real, intent(in) :: missing !< missing value [A] + real, dimension(:,:), intent(in) :: array !< input array in arbitrary units [A ~> a] + real, intent(in) :: missing !< missing value in arbitrary units [A ~> a] integer, intent(in) :: is !< Start index in i integer, intent(in) :: ie !< End index in i integer, intent(in) :: js !< Start index in j integer, intent(in) :: je !< End index in j integer, intent(in) :: k !< Level to calculate statistics for character(len=*), intent(in) :: mesg !< Label to use in message - real, optional, intent(in) :: scale !< A scaling factor for output. + real, optional, intent(in) :: scale !< A scaling factor for output [a A-1 ~> 1] ! Local variables - real :: minA, maxA ! Minimum and maximum vvalues in the array [A] - real :: scl ! A factor for undoing any scaling of the array statistics for output. + real :: minA ! Minimum value in the array in the arbitrary units of the input array [A ~> a] + real :: maxA ! Maximum value in the array in the arbitrary units of the input array [A ~> a] + real :: scl ! A factor for undoing any scaling of the array statistics for output [a A-1 ~> 1] integer :: i,j logical :: found character(len=120) :: lMesg @@ -84,7 +93,7 @@ end subroutine myStats subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, answer_date) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: aout !< The array with missing values to fill [A] + intent(inout) :: aout !< The array with missing values to fill [arbitrary] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: good !< Valid data mask for incoming array !! (1==good data; 0==missing data) [nondim]. @@ -92,9 +101,9 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, intent(in) :: fill !< Same shape array of points which need !! filling (1==fill;0==dont fill) [nondim] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: prev !< First guess where isolated holes exist [A] + intent(in) :: prev !< First guess where isolated holes exist [arbitrary] real, intent(in) :: acrit !< A minimal value for deltas between iterations that - !! determines when the smoothing has converged [A]. + !! determines when the smoothing has converged [arbitrary]. integer, optional, intent(in) :: num_pass !< The maximum number of iterations real, optional, intent(in) :: relc !< A relaxation coefficient for Laplacian [nondim] logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. @@ -103,13 +112,13 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. - real, dimension(SZI_(G),SZJ_(G)) :: a_filled ! The aout with missing values filled in [A] - real, dimension(SZI_(G),SZJ_(G)) :: a_chg ! The change in aout due to an iteration of smoothing [A] + real, dimension(SZI_(G),SZJ_(G)) :: a_filled ! The aout with missing values filled in [arbitrary] + real, dimension(SZI_(G),SZJ_(G)) :: a_chg ! The change in aout due to an iteration of smoothing [arbitrary] real, dimension(SZI_(G),SZJ_(G)) :: fill_pts ! 1 for points that still need to be filled [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good_ ! The values that are valid for the current iteration [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good_new ! The values of good_ to use for the next iteration [nondim] - real :: east, west, north, south ! Valid neighboring values or 0 for invalid values [A] + real :: east, west, north, south ! Valid neighboring values or 0 for invalid values [arbitrary] real :: ge, gw, gn, gs ! Flags indicating which neighbors have valid values [nondim] real :: ngood ! The number of valid values in neighboring points [nondim] real :: nfill ! The remaining number of points to fill [nondim] @@ -250,19 +259,19 @@ subroutine fill_miss_2d(aout, good, fill, prev, G, acrit, num_pass, relc, debug, end subroutine fill_miss_2d !> Extrapolate and interpolate from a file record -subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, & - z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & +subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, recnum, G, tr_z, mask_z, & + z_in, z_edges_in, missing_value, scale, & homogenize, m_to_Z, answers_2018, ongrid, tr_iter_tol, answer_date) character(len=*), intent(in) :: filename !< Path to file containing tracer to be !! interpolated. character(len=*), intent(in) :: varnam !< Name of tracer in file. - real, intent(in) :: conversion !< Conversion factor for tracer [CU conc-1 ~> 1] integer, intent(in) :: recnum !< Record number of tracer to be read. type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z !< Allocatable tracer array on the horizontal - !! model grid and input-file vertical levels. [CU ~> conc] + !! model grid and input-file vertical levels + !! in arbitrary units [A ~> a] real, allocatable, dimension(:,:,:), intent(out) :: mask_z !< Allocatable tracer mask array on the horizontal !! model grid and input-file vertical levels [nondim] @@ -271,10 +280,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, allocatable, dimension(:), intent(out) :: z_edges_in !< Cell grid edge values for input data [Z ~> m] real, intent(out) :: missing_value !< The missing value in the returned array, scaled - !! with conversion to avoid accidentally having valid - !! values match missing values [CU ~> conc] - 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 + !! to avoid accidentally having valid values match + !! missing values in the same units as tr_z [A ~> a] + real, intent(in) :: scale !< Scaling factor for tracer into the internal + !! units of the model for the units in the file [A a-1 ~> 1] logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions real, optional, intent(in) :: m_to_Z !< A conversion factor from meters to the units @@ -287,19 +296,21 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, !! extrapolation is performed by this routine real, optional, intent(in) :: tr_iter_tol !< The tolerance for changes in tracer concentrations !! between smoothing iterations that determines when to - !! stop iterating [CU ~> conc] + !! stop iterating in the same units as tr_z [A ~> a] integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. !! Dates before 20190101 give the same answers !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its !! native horizontal grid, with units that change - !! as the input data is interpreted [conc] then [CU ~> conc] + !! as the input data is interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: tr_inp !< Native horizontal grid data extended to the poles !! with units that change as the input data is - !! interpreted [conc] then [CU ~> conc] + !! interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: mask_in ! A 2-d mask for extended input grid [nondim] real :: PI_180 ! A conversion factor from degrees to radians @@ -311,18 +322,17 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real, dimension(:), allocatable :: lon_in ! The longitudes in the input file [degreesE] then [radians] real, dimension(:), allocatable :: lat_in ! The latitudes in the input file [degreesN] then [radians] real, dimension(:), allocatable :: lat_inp ! The input file latitudes expanded to the pole [degreesN] then [radians] - real :: max_lat ! The maximum latitude on the input grid [degreeN] - real :: pole ! The sum of tracer values at the pole [conc] + real :: max_lat ! The maximum latitude on the input grid [degreesN] + real :: pole ! The sum of tracer values at the pole [a] real :: max_depth ! The maximum depth of the ocean [Z ~> m] real :: npole ! The number of points contributing to the pole value [nondim] - real :: missing_val_in ! The missing value in the input field [conc] + real :: missing_val_in ! The missing value in the input field [a] real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] real :: add_offset, scale_factor ! File-specific conversion factors. integer :: ans_date ! The vintage of the expressions and order of arithmetic to use logical :: found_attr logical :: add_np logical :: is_ongrid - character(len=8) :: laynum type(horiz_interp_type) :: Interp type(axis_info), dimension(4) :: axes_info ! Axis information used for regridding integer :: is, ie, js, je ! compute domain indices @@ -330,19 +340,17 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, integer :: isd, ied, jsd, jed ! data domain indices integer :: id_clock_read logical :: debug=.false. - real :: I_scale ! The inverse of the conversion factor for diagnostic output [conc CU-1 ~> 1] + real :: I_scale ! The inverse of the scale factor for diagnostic output [a A-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing - ! iterations that determines when to stop iterating [CU ~> conc] - real :: npoints ! The number of points in an average [nondim] - real :: varAvg ! The sum of tracer variables being averaged, then their average [CU ~> conc] + ! iterations that determines when to stop iterating [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: lon_out ! The longitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: lat_out ! The latitude of points on the model grid [radians] - real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: mask_out ! The mask on the model grid [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good ! Where the data is valid, this is 1 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill ! 1 where the data needs to be filled in [nondim] - real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [CU ~> conc] - real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [A ~> a] + real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: good2 ! 1 where the data is valid after Ice-9 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill2 ! 1 for points that still need to be filled after Ice-9 [nondim] @@ -355,10 +363,10 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid - dtr_iter_stop = 1.0e-3*conversion + dtr_iter_stop = 1.0e-3*scale if (present(tr_iter_tol)) dtr_iter_stop = tr_iter_tol - I_scale = 1.0 / conversion + I_scale = 1.0 / scale PI_180 = atan(1.0)/45. @@ -371,6 +379,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call cpu_clock_begin(id_clock_read) + ! A note by MJH copied from elsewhere suggests that this code may be using the model connectivity + ! (e.g., reentrant or tripolar) but should use the dataset's connectivity instead. + call get_var_axes_info(trim(filename), trim(varnam), axes_info) if (allocated(z_in)) deallocate(z_in) @@ -418,7 +429,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (.not. found_attr) call MOM_error(FATAL, & "error finding missing value for " // trim(varnam) // & " in file " // trim(filename) // " in hinterp_extrap") - missing_value = conversion * missing_val_in + missing_value = scale * missing_val_in call read_attribute(trim(filename), "scale_factor", scale_factor, & varname=trim(varnam), found=found_attr) @@ -459,19 +470,18 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, ! 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 - write(laynum,'(I8)') k ; laynum = adjustl(laynum) mask_in(:,:) = 0.0 tr_out(:,:) = 0.0 if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k - count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1; start(4) = 1; count(4) = 1 + count(1) = ie-is+1 ; count(2) = je-js+1 ; count(3) = 1 ; start(4) = 1 ; count(4) = 1 call MOM_read_data(trim(filename), trim(varnam), tr_in, start, count, G%Domain) do j=js,je do i=is,ie if (abs(tr_in(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then mask_in(i,j) = 1.0 - tr_in(i,j) = (tr_in(i,j)*scale_factor+add_offset) * conversion + tr_in(i,j) = (tr_in(i,j)*scale_factor+add_offset) * scale else tr_in(i,j) = missing_value endif @@ -485,6 +495,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, start(:) = 1 ; start(3) = k count(:) = 1 ; count(1) = id ; count(2) = jd call read_variable(trim(filename), trim(varnam), tr_in, start=start, nread=count) + if (is_root_pe()) then if (add_np) then pole = 0.0 ; npole = 0.0 @@ -511,7 +522,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, do j=1,jdp ; do i=1,id if (abs(tr_inp(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then mask_in(i,j) = 1.0 - tr_inp(i,j) = (tr_inp(i,j)*scale_factor+add_offset) * conversion + tr_inp(i,j) = (tr_inp(i,j)*scale_factor+add_offset) * scale else tr_inp(i,j) = missing_value endif @@ -537,14 +548,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, fill(:,:) = 0.0 ; good(:,:) = 0.0 - nPoints = 0 ; varAvg = 0. do j=js,je ; do i=is,ie if (mask_out(i,j) < 1.0) then tr_out(i,j) = missing_value else good(i,j) = 1.0 - 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) + G%Z_ref) .and. & (mask_out(i,j) < 1.0)) & @@ -559,13 +567,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, ! Horizontally homogenize data to produce perfectly "flat" initial conditions if (PRESENT(homogenize)) then ; if (homogenize) then - !### These averages will not reproduce across PE layouts or grid rotation. - call sum_across_PEs(nPoints) - call sum_across_PEs(varAvg) - if (nPoints>0) then - varAvg = varAvg / real(nPoints) - endif - tr_out(:,:) = varAvg + call homogenize_field(tr_out, mask_out, G, scale, answer_date) endif ; endif ! tr_out contains input z-space data on the model grid with missing values @@ -596,18 +598,18 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle -subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, & - z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & +subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, G, tr_z, mask_z, & + z_in, z_edges_in, missing_value, scale, & homogenize, spongeOngrid, m_to_Z, & answers_2018, tr_iter_tol, answer_date) integer, intent(in) :: fms_id !< A unique id used by the FMS time interpolator type(time_type), intent(in) :: Time !< A FMS time type - real, intent(in) :: conversion !< Conversion factor for tracer. type(ocean_grid_type), intent(inout) :: G !< Grid object real, allocatable, dimension(:,:,:), intent(out) :: tr_z !< Allocatable tracer array on the horizontal - !! model grid and input-file vertical levels. [CU ~> conc] + !! model grid and input-file vertical levels + !! in arbitrary units [A ~> a] real, allocatable, dimension(:,:,:), intent(out) :: mask_z !< Allocatable tracer mask array on the horizontal !! model grid and input-file vertical levels [nondim] @@ -616,10 +618,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t real, allocatable, dimension(:), intent(out) :: z_edges_in !< Cell grid edge values for input data [Z ~> m] real, intent(out) :: missing_value !< The missing value in the returned array, scaled - !! with conversion to avoid accidentally having valid - !! values match missing values [CU ~> conc] - 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 + !! to avoid accidentally having valid values match + !! missing values, in the same arbitrary units as tr_z [A ~> a] + real, intent(in) :: scale !< Scaling factor for tracer into the internal + !! units of the model [A a-1 ~> 1] logical, optional, intent(in) :: homogenize !< If present and true, horizontally homogenize data !! to produce perfectly "flat" initial conditions logical, optional, intent(in) :: spongeOngrid !< If present and true, the sponge data are on the model grid @@ -630,21 +632,23 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t !! add parentheses for rotational symmetry. real, optional, intent(in) :: tr_iter_tol !< The tolerance for changes in tracer concentrations !! between smoothing iterations that determines when to - !! stop iterating [CU ~> conc] + !! stop iterating, in the same arbitrary units as tr_z [A ~> a] integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. !! Dates before 20190101 give the same answers !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. ! Local variables + ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the + ! input array while [a] indicates the unscaled (e.g., mks) units that can be used with the reproducing sums real, dimension(:,:), allocatable :: tr_in !< A 2-d array for holding input data on its !! native horizontal grid, with units that change - !! as the input data is interpreted [conc] then [CU ~> conc] + !! as the input data is interpreted [a] then [A ~> a] real, dimension(:,:), allocatable :: tr_inp !< Native horizontal grid data extended to the poles !! with units that change as the input data is - !! interpreted [conc] then [CU ~> conc] + !! interpreted [a] then [A ~> a] real, dimension(:,:,:), allocatable :: data_in !< A buffer for storing the full 3-d time-interpolated array - !! on the original grid [conc] + !! on the original grid [a] real, dimension(:,:), allocatable :: mask_in !< A 2-d mask for extended input grid [nondim] real :: PI_180 ! A conversion factor from degrees to radians @@ -655,14 +659,13 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t real, dimension(:), allocatable :: lon_in ! The longitudes in the input file [degreesE] then [radians] real, dimension(:), allocatable :: lat_in ! The latitudes in the input file [degreesN] then [radians] real, dimension(:), allocatable :: lat_inp ! The input file latitudes expanded to the pole [degreesN] then [radians] - real :: max_lat ! The maximum latitude on the input grid [degreeN] - real :: pole ! The sum of tracer values at the pole [conc] + real :: max_lat ! The maximum latitude on the input grid [degreesN] + real :: pole ! The sum of tracer values at the pole [a] real :: max_depth ! The maximum depth of the ocean [Z ~> m] real :: npole ! The number of points contributing to the pole value [nondim] - real :: missing_val_in ! The missing value in the input field [conc] + real :: missing_val_in ! The missing value in the input field [a] real :: roundoff ! The magnitude of roundoff, usually ~2e-16 [nondim] logical :: add_np - character(len=8) :: laynum type(horiz_interp_type) :: Interp type(axistype), dimension(4) :: axes_data integer :: is, ie, js, je ! compute domain indices @@ -673,19 +676,17 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t logical :: debug=.false. logical :: is_ongrid integer :: ans_date ! The vintage of the expressions and order of arithmetic to use - real :: I_scale ! The inverse of the conversion factor for diagnostic output [conc CU-1 ~> 1] + real :: I_scale ! The inverse of the scale factor for diagnostic output [a A-1 ~> 1] real :: dtr_iter_stop ! The tolerance for changes in tracer concentrations between smoothing - ! iterations that determines when to stop iterating [CU ~> conc] - real :: npoints ! The number of points in an average [nondim] - real :: varAvg ! The sum of tracer variables being averaged, then their average [CU ~> conc] + ! iterations that determines when to stop iterating [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: lon_out ! The longitude of points on the model grid [radians] real, dimension(SZI_(G),SZJ_(G)) :: lat_out ! The latitude of points on the model grid [radians] - real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_out ! The tracer on the model grid [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: mask_out ! The mask on the model grid [nondim] real, dimension(SZI_(G),SZJ_(G)) :: good ! Where the data is valid, this is 1 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill ! 1 where the data needs to be filled in [nondim] - real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [CU ~> conc] - real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [CU ~> conc] + real, dimension(SZI_(G),SZJ_(G)) :: tr_outf ! The tracer concentrations after Ice-9 [A ~> a] + real, dimension(SZI_(G),SZJ_(G)) :: tr_prev ! The tracer concentrations in the layer above [A ~> a] real, dimension(SZI_(G),SZJ_(G)) :: good2 ! 1 where the data is valid after Ice-9 [nondim] real, dimension(SZI_(G),SZJ_(G)) :: fill2 ! 1 for points that still need to be filled after Ice-9 [nondim] integer :: turns @@ -699,10 +700,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t id_clock_read = cpu_clock_id('(Initialize tracer from Z) read', grain=CLOCK_LOOP) - dtr_iter_stop = 1.0e-3*conversion + dtr_iter_stop = 1.0e-3*scale if (present(tr_iter_tol)) dtr_iter_stop = tr_iter_tol - I_scale = 1.0 / conversion + I_scale = 1.0 / scale PI_180 = atan(1.0)/45. @@ -716,7 +717,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call cpu_clock_begin(id_clock_read) call get_external_field_info(fms_id, size=fld_sz, axes=axes_data, missing=missing_val_in) - missing_value = conversion*missing_val_in + missing_value = scale*missing_val_in verbosity = MOM_get_verbosity() @@ -790,10 +791,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t if (.not.is_ongrid) then if (is_root_pe()) & call time_interp_external(fms_id, Time, data_in, verbose=(verbosity>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 - write(laynum,'(I8)') k ; laynum = adjustl(laynum) if (is_root_pe()) then tr_in(1:id,1:jd) = data_in(1:id,1:jd,k) if (add_np) then @@ -823,7 +824,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do j=1,jdp ; do i=1,id if (abs(tr_inp(i,j)-missing_val_in) > abs(roundoff*missing_val_in)) then mask_in(i,j) = 1.0 - tr_inp(i,j) = tr_inp(i,j) * conversion + tr_inp(i,j) = tr_inp(i,j) * scale else tr_inp(i,j) = missing_value endif @@ -850,14 +851,11 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t fill(:,:) = 0.0 ; good(:,:) = 0.0 - nPoints = 0 ; varAvg = 0. do j=js,je ; do i=is,ie if (mask_out(i,j) < 1.0) then tr_out(i,j) = missing_value else good(i,j) = 1.0 - 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) + G%Z_ref) .and. & (mask_out(i,j) < 1.0)) & @@ -872,13 +870,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t ! Horizontally homogenize data to produce perfectly "flat" initial conditions if (PRESENT(homogenize)) then ; if (homogenize) then - !### These averages will not reproduce across PE layouts or grid rotation. - call sum_across_PEs(nPoints) - call sum_across_PEs(varAvg) - if (nPoints>0) then - varAvg = varAvg / real(nPoints) - endif - tr_out(:,:) = varAvg + call homogenize_field(tr_out, mask_out, G, scale, answer_date) endif ; endif ! tr_out contains input z-space data on the model grid with missing values @@ -909,7 +901,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t do k=1,kd do j=js,je do i=is,ie - tr_z(i,j,k) = data_in(i,j,k) * conversion + tr_z(i,j,k) = data_in(i,j,k) * scale if (ans_date >= 20190101) mask_z(i,j,k) = 1. if (abs(tr_z(i,j,k)-missing_value) < abs(roundoff*missing_value)) mask_z(i,j,k) = 0. enddo @@ -919,12 +911,91 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t end subroutine horiz_interp_and_extrap_tracer_fms_id +!> Replace all values of a 2-d field with the weighted average over the valid points. +subroutine homogenize_field(field, weight, G, scale, answer_date, wt_unscale) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid type + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: field !< The tracer on the model grid in arbitrary units [A ~> a] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: weight !< The weights for the tracer in arbitrary units that + !! typically differ from those used by field [B ~> b] + real, intent(in) :: scale !< A rescaling factor that has been used for the + !! variable and has to be undone before the + !! reproducing sums [A a-1 ~> 1] + integer, optional, intent(in) :: answer_date !< The vintage of the expressions in the code. + !! Dates before 20230101 use non-reproducing sums + !! in their averages, while later versions use + !! reproducing sums for rotational symmetry and + !! consistency across PE layouts. + real, optional, intent(in) :: wt_unscale !< A factor that undoes any dimensional scaling + !! of the weights so that they can be used with + !! reproducing sums [b B-1 ~> 1] + + ! Local variables + ! In the following comments, [A] and [B] are used to indicate the arbitrary, possibly rescaled + ! units of the input field and the weighting array, while [a] and [b] indicate the corresponding + ! unscaled (e.g., mks) units that can be used with the reproducing sums + real, dimension(SZI_(G),SZJ_(G)) :: field_for_Sums ! The field times the weights with the scaling undone [a b] + real, dimension(SZI_(G),SZJ_(G)) :: wts_for_Sums ! A copy of the wieghts with the scaling undone [b] + real :: var_unscale ! The reciprocal of the scaling factor for the field and weights [a b A-1 B-1 ~> 1] + real :: wt_descale ! A factor that undoes any dimensional scaling of the weights so that they + ! can be used with reproducing sums [b B-1 ~> 1] + real :: wt_sum ! The sum of the weights, in [b] (reproducing) or [B ~> b] (non-reproducing) + real :: varsum ! The weighted sum of field being averaged [A B ~> a b] + real :: varAvg ! The average of the field [A ~> a] + logical :: use_repro_sums ! If true, use reproducing sums. + integer :: i, j, is, ie, js, je + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + varAvg = 0.0 ! This value will be used if wt_sum is 0. + + use_repro_sums = .false. ; if (present(answer_date)) use_repro_sums = (answer_date >= 20230101) + + if (scale == 0.0) then + ! This seems like an unlikely case to ever be used, but dealing with it is better than having NaNs arise? + varAvg = 0.0 + elseif (use_repro_sums) then + wt_descale = 1.0 ; if (present(wt_unscale)) wt_descale = wt_unscale + var_unscale = wt_descale / scale + + field_for_Sums(:,:) = 0.0 + wts_for_Sums(:,:) = 0.0 + do j=js,je ; do i=is,ie + wts_for_Sums(i,j) = wt_descale * weight(i,j) + field_for_Sums(i,j) = var_unscale * (field(i,j) * weight(i,j)) + enddo ; enddo + + wt_sum = reproducing_sum(wts_for_Sums) + if (abs(wt_sum) > 0.0) & + varAvg = reproducing_sum(field_for_Sums) * (scale / wt_sum) + + else ! Do the averages with order-dependent sums to reproduce older answers. + wt_sum = 0 ; varsum = 0. + do j=js,je ; do i=is,ie + if (weight(i,j) > 0.0) then + wt_sum = wt_sum + weight(i,j) + varsum = varsum + field(i,j) * weight(i,j) + endif + enddo ; enddo + + ! Note that these averages will not reproduce across PE layouts or grid rotation. + call sum_across_PEs(wt_sum) + if (wt_sum > 0.0) then + call sum_across_PEs(varsum) + varAvg = varsum / wt_sum + endif + endif + + field(:,:) = varAvg + +end subroutine homogenize_field + + !> Create a 2d-mesh of grid coordinates from 1-d arrays. subroutine meshgrid(x, y, x_T, y_T) - real, dimension(:), intent(in) :: x !< input 1-dimensional vector - real, dimension(:), intent(in) :: y !< input 1-dimensional vector - real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array - real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array + real, dimension(:), intent(in) :: x !< input 1-dimensional vector [arbitrary] + real, dimension(:), intent(in) :: y !< input 1-dimensional vector [arbitrary] + real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T !< output 2-dimensional array [arbitrary] + real, dimension(size(x,1),size(y,1)), intent(inout) :: y_T !< output 2-dimensional array [arbitrary] integer :: ni, nj, i, j diff --git a/src/framework/MOM_intrinsic_functions.F90 b/src/framework/MOM_intrinsic_functions.F90 index fdda8849ae..2439c628fc 100644 --- a/src/framework/MOM_intrinsic_functions.F90 +++ b/src/framework/MOM_intrinsic_functions.F90 @@ -13,9 +13,9 @@ module MOM_intrinsic_functions !> Evaluate the inverse cosh, either using a math library or an !! equivalent expression function invcosh(x) - real, intent(in) :: x !< The argument of the inverse of cosh. NaNs will + real, intent(in) :: x !< The argument of the inverse of cosh [nondim]. NaNs will !! occur if x<1, but there is no error checking - real :: invcosh + real :: invcosh ! The inverse of cosh of x [nondim] #ifdef __INTEL_COMPILER invcosh = acosh(x) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index e8df89b268..1026216426 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -15,15 +15,17 @@ module MOM_io 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 -use MOM_io_infra, only : get_file_times, axistype, get_axis_data, get_filename_suffix -use MOM_io_infra, only : write_field, write_metadata, write_version +use MOM_io_infra, only : file_exists +use MOM_io_infra, only : open_ASCII_file, close_file, file_is_open +use MOM_io_infra, only : get_field_size, field_exists, get_field_atts +use MOM_io_infra, only : get_axis_data, get_filename_suffix +use MOM_io_infra, only : write_version use MOM_io_infra, only : MOM_namelist_file, check_namelist_error, io_infra_init, io_infra_end use MOM_io_infra, only : APPEND_FILE, ASCII_FILE, MULTIPLE, NETCDF_FILE, OVERWRITE_FILE use MOM_io_infra, only : READONLY_FILE, SINGLE_FILE, WRITEONLY_FILE use MOM_io_infra, only : CENTER, CORNER, NORTH_FACE, EAST_FACE +use MOM_io_file, only : MOM_file, MOM_infra_file, MOM_netcdf_file +use MOM_io_file, only : MOM_axis, MOM_field use MOM_string_functions, only : lowercase, slasher use MOM_verticalGrid, only : verticalGrid_type @@ -33,21 +35,34 @@ module MOM_io use netcdf, only : NF90_strerror, NF90_inquire_dimension use netcdf, only : NF90_NOWRITE, NF90_NOERR, NF90_GLOBAL, NF90_ENOTATT, NF90_CHAR +! The following are not used in MOM6, but may be used by externals (e.g. SIS2). +use MOM_io_infra, only : axistype ! still used but soon to be nuked +use MOM_io_infra, only : fieldtype +use MOM_io_infra, only : file_type +use MOM_io_infra, only : get_file_info +use MOM_io_infra, only : get_file_fields +use MOM_io_infra, only : get_file_times +use MOM_io_infra, only : open_file +use MOM_io_infra, only : write_field + implicit none ; private ! These interfaces are actually implemented in this file. -public :: create_file, reopen_file, cmor_long_std, ensembler, MOM_io_init +public :: create_MOM_file, reopen_MOM_file, cmor_long_std, ensembler, MOM_io_init +public :: MOM_field public :: MOM_write_field, var_desc, modify_vardesc, query_vardesc, position_from_horgrid public :: open_namelist_file, check_namelist_error, check_nml_error public :: get_var_sizes, verify_variable_units, num_timelevels, read_variable, read_attribute public :: open_file_to_read, close_file_to_read ! The following are simple pass throughs of routines from MOM_io_infra or other modules. -public :: file_exists, open_file, open_ASCII_file, close_file, flush_file, file_type -public :: get_file_info, field_exists, get_file_fields, get_file_times, get_filename_appendix +public :: file_exists, open_ASCII_file, close_file +public :: MOM_file, MOM_infra_file, MOM_netcdf_file +public :: field_exists, get_filename_appendix public :: fieldtype, field_size, get_field_atts public :: axistype, get_axis_data public :: MOM_read_data, MOM_read_vector, read_field_chksum -public :: slasher, write_field, write_version_number +public :: read_netCDF_data +public :: slasher, write_version_number public :: io_infra_init, io_infra_end public :: stdout_if_root public :: get_var_axes_info @@ -67,6 +82,15 @@ module MOM_io !> These encoding constants are used to indicate the discretization position of a variable public :: CENTER, CORNER, NORTH_FACE, EAST_FACE +! The following are not used in MOM6, but may be used by externals (e.g. SIS2). +public :: create_file +public :: reopen_file +public :: file_type +public :: open_file +public :: get_file_info +public :: get_file_fields +public :: get_file_times + !> Read a field from file using the infrastructure I/O. interface MOM_read_data module procedure MOM_read_data_0d @@ -85,8 +109,22 @@ module MOM_io module procedure MOM_read_vector_3d end interface MOM_read_vector +!> Read a field using native netCDF I/O +!! +!! This function is primarily used for unstructured data which may contain +!! content that cannot be parsed by infrastructure I/O. +interface read_netCDF_data + ! NOTE: Only 2D I/O is currently used; this should be expanded as needed. + module procedure read_netCDF_data_2d +end interface read_netCDF_data + !> Write a registered field to an output file, potentially with rotation interface MOM_write_field + module procedure MOM_write_field_legacy_4d + module procedure MOM_write_field_legacy_3d + module procedure MOM_write_field_legacy_2d + module procedure MOM_write_field_legacy_1d + module procedure MOM_write_field_legacy_0d module procedure MOM_write_field_4d module procedure MOM_write_field_3d module procedure MOM_write_field_2d @@ -120,8 +158,9 @@ module MOM_io character(len=64) :: cmor_field_name !< CMOR name character(len=64) :: cmor_units !< CMOR physical dimensions of the variable character(len=240) :: cmor_longname !< CMOR long name of the variable - real :: conversion !< for unit conversions, such as needed to - !! convert from intensive to extensive + real :: conversion !< for unit conversions, such as needed to convert + !! from intensive to extensive [various] or [a A-1 ~> 1] + !! to undo internal dimensional rescaling character(len=32) :: dim_names(5) !< The names in the file of the axes for this variable integer :: position = -1 !< An integer encoding the horizontal position, it may !! CENTER, CORNER, EAST_FACE, NORTH_FACE, or 0. @@ -138,7 +177,7 @@ module MOM_io integer :: sense = 0 !< This is 1 for axes whose values increase upward, or -1 !! if they increase downward. The default, 0, is ignored. integer :: ax_size = 0 !< The number of elements in this axis - real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis. + real, allocatable, dimension(:) :: ax_data !< The values of the data on the axis [arbitrary] end type axis_info !> Type that stores for a global file attribute @@ -147,23 +186,77 @@ module MOM_io character(len=:), allocatable :: att_val !< The values of this attribute end type attribute_info - integer, public :: stdout = stdout_iso !< standard output unit integer, public :: stderr = stderr_iso !< standard output unit +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + contains -!> Routine creates a new NetCDF file. It also sets up fieldtype -!! structures that describe this file and variables that will -!! later be written to this file. -subroutine create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G, dG, GV, checksums, extra_axes, global_atts) - type(file_type), intent(inout) :: IO_handle !< Handle for a files or fileset that is to be +!> `create_MOM_file` wrapper for the legacy file handle, `file_type`. +!! NOTE: This function may be removed in a future release. +subroutine create_file(IO_handle, filename, vars, novars, fields, threading, & + timeunit, G, dG, GV, checksums, extra_axes, global_atts) + type(file_type), intent(inout) :: IO_handle + !< Handle for a files or fileset that is to be opened or reopened for + !! writing + character(len=*), intent(in) :: filename + !< full path to the file to create + type(vardesc), intent(in) :: vars(:) + !< structures describing fields written to filename + integer, intent(in) :: novars + !< number of fields written to filename + type(fieldtype), intent(inout) :: fields(:) + !< array of fieldtypes for each variable + integer, optional, intent(in) :: threading + !< SINGLE_FILE or MULTIPLE + real, optional, intent(in) :: timeunit + !< length of the units for time [s]. The default value is 86400.0, for 1 + !! day. + type(ocean_grid_type), optional, intent(in) :: G + !< ocean horizontal grid structure; G or dG is required if the new file + !! uses any horizontal grid axes. + type(dyn_horgrid_type), optional, intent(in) :: dG + !< dynamic horizontal grid structure; G or dG is required if the new file + !! uses any horizontal grid axes. + type(verticalGrid_type), optional, intent(in) :: GV + !< ocean vertical grid structure, which is ! required if the new file uses + !! any vertical grid axes. + integer(kind=int64), optional, intent(in) :: checksums(:,:) + !< checksums of vars + type(axis_info), optional, intent(in) :: extra_axes(:) + !< Types with information about some axes that might be used in this file + type(attribute_info), optional, intent(in) :: global_atts(:) + !< Global attributes to write to this file + + type(MOM_infra_file) :: new_file + type(MOM_field) :: new_fields(novars) + + new_file%handle_infra = IO_handle + + call create_MOM_file(new_file, filename, vars, novars, new_fields, & + threading=threading, timeunit=timeunit, G=G, dG=dG, GV=GV, & + checksums=checksums, extra_axes=extra_axes, global_atts=global_atts) + + IO_handle = new_file%handle_infra + call new_file%get_file_fieldtypes(fields(:novars)) +end subroutine create_file + + +!! Create a new netCDF file and register the MOM_fields to be written. +subroutine create_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G, dG, GV, checksums, extra_axes, global_atts) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a files or fileset that is to be !! opened or reopened for writing character(len=*), intent(in) :: filename !< full path to the file to create type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename integer, intent(in) :: novars !< number of fields written to filename - type(fieldtype), intent(inout) :: fields(:) !< array of fieldtypes for each variable + type(MOM_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE real, optional, intent(in) :: timeunit !< length of the units for time [s]. The !! default value is 86400.0, for 1 day. @@ -186,21 +279,22 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim logical :: use_layer, use_int, use_periodic logical :: one_file, domain_set, dim_found logical, dimension(:), allocatable :: use_extra_axis - type(axistype) :: axis_lath, axis_latq, axis_lonh, axis_lonq - type(axistype) :: axis_layer, axis_int, axis_time, axis_periodic - type(axistype), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes - type(axistype) :: axes(5) ! The axes of a variable + type(MOM_axis) :: axis_lath, axis_latq, axis_lonh, axis_lonq + type(MOM_axis) :: axis_layer, axis_int, axis_time, axis_periodic + type(MOM_axis), dimension(:), allocatable :: more_axes ! Axes generated from extra_axes + type(MOM_axis) :: axes(5) ! The axes of a variable type(MOM_domain_type), pointer :: Domain => NULL() type(domain1d) :: x_domain, y_domain integer :: position, numaxes, pack, thread, k, n, m integer :: num_extra_dims ! The number of extra possible dimensions from extra_axes integer :: isg, ieg, jsg, jeg, IsgB, IegB, JsgB, JegB integer :: var_periods, num_periods=0 - real, dimension(:), allocatable :: axis_val + real, dimension(:), allocatable :: axis_val ! Axis label values [various] real, pointer, dimension(:) :: & - gridLatT => NULL(), & ! The latitude or longitude of T or B points for - gridLatB => NULL(), & ! the purpose of labeling the output axes. - gridLonT => NULL(), gridLonB => NULL() + gridLatT => NULL(), & ! The latitude of T or B points for the purpose of labeling + gridLatB => NULL(), & ! the output axes, often in units of [degrees_N] or [km] or [m]. + gridLonT => NULL(), & ! The longitude of T or B points for the purpose of labeling + gridLonB => NULL() ! the output axes, often in units of [degrees_E] or [km] or [m]. character(len=40) :: time_units, x_axis_units, y_axis_units character(len=8) :: t_grid, t_grid_read character(len=64) :: ax_name(5) ! The axis names of a variable @@ -244,9 +338,9 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then - call open_file(IO_handle, filename, OVERWRITE_FILE, threading=thread) + call IO_handle%open(filename, action=OVERWRITE_FILE, threading=thread) else - call open_file(IO_handle, filename, OVERWRITE_FILE, MOM_domain=Domain) + call IO_handle%open(filename, action=OVERWRITE_FILE, MOM_domain=Domain) endif ! Define the coordinates. @@ -326,28 +420,23 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim "create_file: A vertical grid type is required to create a file with a vertical coordinate.") if (use_lath) & - call write_metadata(IO_handle, axis_lath, name="lath", units=y_axis_units, longname="Latitude", & + axis_lath = IO_handle%register_axis("lath", units=y_axis_units, longname="Latitude", & cartesian='Y', domain=y_domain, data=gridLatT(jsg:jeg)) - if (use_lonh) & - call write_metadata(IO_handle, axis_lonh, name="lonh", units=x_axis_units, longname="Longitude", & + axis_lonh = IO_handle%register_axis("lonh", units=x_axis_units, longname="Longitude", & cartesian='X', domain=x_domain, data=gridLonT(isg:ieg)) - if (use_latq) & - call write_metadata(IO_handle, axis_latq, name="latq", units=y_axis_units, longname="Latitude", & + axis_latq = IO_handle%register_axis("latq", units=y_axis_units, longname="Latitude", & cartesian='Y', domain=y_domain, data=gridLatB(JsgB:JegB), edge_axis=.true.) - if (use_lonq) & - call write_metadata(IO_handle, axis_lonq, name="lonq", units=x_axis_units, longname="Longitude", & + axis_lonq = IO_handle%register_axis("lonq", units=x_axis_units, longname="Longitude", & cartesian='X', domain=x_domain, data=gridLonB(IsgB:IegB), edge_axis=.true.) - if (use_layer) & - call write_metadata(IO_handle, axis_layer, name="Layer", units=trim(GV%zAxisUnits), & + axis_layer = IO_handle%register_axis("Layer", units=trim(GV%zAxisUnits), & longname="Layer "//trim(GV%zAxisLongName), cartesian='Z', & sense=1, data=GV%sLayer(1:GV%ke)) - if (use_int) & - call write_metadata(IO_handle, axis_int, name="Interface", units=trim(GV%zAxisUnits), & + axis_int = IO_handle%register_axis("Interface", units=trim(GV%zAxisUnits), & longname="Interface "//trim(GV%zAxisLongName), cartesian='Z', & sense=1, data=GV%sInterface(1:GV%ke+1)) @@ -367,9 +456,9 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim write(time_units,'(es8.2," s")') timeunit endif - call write_metadata(IO_handle, axis_time, name="Time", units=time_units, longname="Time", cartesian='T') + axis_time = IO_handle%register_axis("Time", units=time_units, longname="Time", cartesian='T') else - call write_metadata(IO_handle, axis_time, name="Time", units="days", longname="Time", cartesian='T') + axis_time = IO_handle%register_axis("Time", units="days", longname="Time", cartesian='T') endif ; endif if (use_periodic) then @@ -378,24 +467,24 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim ! Define a periodic axis with unit labels. allocate(axis_val(num_periods)) do k=1,num_periods ; axis_val(k) = real(k) ; enddo - call write_metadata(IO_handle, axis_periodic, name="Period", units="nondimensional", & - longname="Periods for cyclical variables", cartesian='T', data=axis_val) + axis_periodic = IO_handle%register_axis("Period", units="nondimensional", & + longname="Periods for cyclical variables", cartesian='T', data=axis_val) deallocate(axis_val) endif do m=1,num_extra_dims ; if (use_extra_axis(m)) then if (allocated(extra_axes(m)%ax_data)) then - call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, & longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, & sense=extra_axes(m)%sense, data=extra_axes(m)%ax_data) elseif (trim(extra_axes(m)%cartesian) == "T") then - call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, & longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian) else ! FMS requires that non-time axes have variables that label their values, even if they are trivial. allocate (axis_val(extra_axes(m)%ax_size)) do k=1,extra_axes(m)%ax_size ; axis_val(k) = real(k) ; enddo - call write_metadata(IO_handle, more_axes(m), name=extra_axes(m)%name, units=extra_axes(m)%units, & + more_axes(m) = IO_handle%register_axis(extra_axes(m)%name, units=extra_axes(m)%units, & longname=extra_axes(m)%longname, cartesian=extra_axes(m)%cartesian, & sense=extra_axes(m)%sense, data=axis_val) deallocate(axis_val) @@ -457,10 +546,10 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim pack = 1 if (present(checksums)) then - call write_metadata(IO_handle, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, & + fields(k) = IO_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, & vars(k)%longname, pack=pack, checksum=checksums(k,:)) else - call write_metadata(IO_handle, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, & + fields(k) = IO_handle%register_field(axes(1:numaxes), vars(k)%name, vars(k)%units, & vars(k)%longname, pack=pack) endif enddo @@ -468,41 +557,92 @@ subroutine create_file(IO_handle, filename, vars, novars, fields, threading, tim if (present(global_atts)) then do n=1,size(global_atts) if (allocated(global_atts(n)%name) .and. allocated(global_atts(n)%att_val)) & - call write_metadata(IO_handle, global_atts(n)%name, global_atts(n)%att_val) + call IO_handle%write_attribute(global_atts(n)%name, global_atts(n)%att_val) enddo endif - ! Now actualy write the variables with the axis label values - if (use_lath) call write_field(IO_handle, axis_lath) - if (use_latq) call write_field(IO_handle, axis_latq) - if (use_lonh) call write_field(IO_handle, axis_lonh) - if (use_lonq) call write_field(IO_handle, axis_lonq) - if (use_layer) call write_field(IO_handle, axis_layer) - if (use_int) call write_field(IO_handle, axis_int) - if (use_periodic) call write_field(IO_handle, axis_periodic) + ! Now write the variables with the axis label values + if (use_lath) call IO_handle%write_field(axis_lath) + if (use_latq) call IO_handle%write_field(axis_latq) + if (use_lonh) call IO_handle%write_field(axis_lonh) + if (use_lonq) call IO_handle%write_field(axis_lonq) + if (use_layer) call IO_handle%write_field(axis_layer) + if (use_int) call IO_handle%write_field(axis_int) + if (use_periodic) call IO_handle%write_field(axis_periodic) do m=1,num_extra_dims ; if (use_extra_axis(m)) then - call write_field(IO_handle, more_axes(m)) + call IO_handle%write_field(more_axes(m)) endif ; enddo if (num_extra_dims > 0) then deallocate(use_extra_axis, more_axes) endif +end subroutine create_MOM_file + + +!> `reopen_MOM_file` wrapper for the legacy file handle, `file_type`. +!! NOTE: This function may be removed in a future release. +subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, & + timeunit, G, dG, GV, extra_axes, global_atts) + type(file_type), intent(inout) :: IO_handle + !< Handle for a file or fileset that is to be opened or reopened for + !! writing + character(len=*), intent(in) :: filename + !< full path to the file to create + type(vardesc), intent(in) :: vars(:) + !< structures describing fields written to filename + integer, intent(in) :: novars + !< number of fields written to filename + type(fieldtype), intent(inout) :: fields(:) + !< array of fieldtypes for each variable + integer, optional, intent(in) :: threading + !< SINGLE_FILE or MULTIPLE + real, optional, intent(in) :: timeunit + !< length of the units for time [s]. The default value is 86400.0, for 1 + !! day. + type(ocean_grid_type), optional, intent(in) :: G + !< ocean horizontal grid structure; G or dG is required if a new file uses + !! any horizontal grid axes. + type(dyn_horgrid_type), optional, intent(in) :: dG + !< dynamic horizontal grid structure; G or dG is required if a new file + !! uses any horizontal grid axes. + type(verticalGrid_type), optional, intent(in) :: GV + !< ocean vertical grid structure, which is required if a new file uses any + !! vertical grid axes. + type(axis_info), optional, intent(in) :: extra_axes(:) + !< Types with information about some axes that might be used in this file + type(attribute_info), optional, intent(in) :: global_atts(:) + !< Global attributes to write to this file + + type(MOM_infra_file) :: mfile + !< Wrapper to MOM file + type(MOM_field), allocatable :: mfields(:) + !< Wrapper to MOM fields + integer :: i -end subroutine create_file + mfile%handle_infra = IO_handle + allocate(mfields(size(fields))) + + call reopen_MOM_file(mfile, filename, vars, novars, mfields, & + threading=threading, timeunit=timeunit, G=G, dG=dG, GV=GV, & + extra_axes=extra_axes, global_atts=global_atts) + + IO_handle = mfile%handle_infra + call get_file_fields(IO_handle, fields) +end subroutine reopen_file !> This routine opens an existing NetCDF file for output. If it !! does not find the file, a new file is created. It also sets up !! structures that describe this file and the variables that will !! later be written to this file. -subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G, dG, GV, extra_axes, global_atts) - type(file_type), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be +subroutine reopen_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G, dG, GV, extra_axes, global_atts) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file or fileset that is to be !! opened or reopened for writing character(len=*), intent(in) :: filename !< full path to the file to create type(vardesc), intent(in) :: vars(:) !< structures describing fields written to filename integer, intent(in) :: novars !< number of fields written to filename - type(fieldtype), intent(inout) :: fields(:) !< array of fieldtypes for each variable + type(MOM_field), intent(inout) :: fields(:) !< array of fieldtypes for each variable integer, optional, intent(in) :: threading !< SINGLE_FILE or MULTIPLE real, optional, intent(in) :: timeunit !< length of the units for time [s]. The !! default value is 86400.0, for 1 day. @@ -528,6 +668,20 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim thread = SINGLE_FILE if (PRESENT(threading)) thread = threading + ! For single-file IO, only the root PE is required to set up the fields. + ! This permits calls by either the root PE or all PEs + if (.not. is_root_PE() .and. thread == SINGLE_FILE) return + + ! For multiple IO domains, we would need additional functionality: + ! * Identify ranks as IO PEs + ! * Determine the filename of + ! Neither of these tasks should be handed by MOM6, so we cannot safely use + ! this function. A framework-specific `inquire()` function is needed. + ! Until it exists, we will disable this function. + if (thread == MULTIPLE) & + call MOM_error(FATAL, 'reopen_MOM_file does not yet support files with ' & + // 'multiple I/O domains.') + check_name = filename length = len(trim(check_name)) if (check_name(length-2:length) /= ".nc") check_name = trim(check_name)//".nc" @@ -536,8 +690,9 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim inquire(file=check_name,EXIST=exists) if (.not.exists) then - call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G=G, dG=dG, GV=GV, extra_axes=extra_axes, global_atts=global_atts) + call create_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G=G, dG=dG, GV=GV, extra_axes=extra_axes, & + global_atts=global_atts) else domain_set = .false. @@ -551,40 +706,31 @@ subroutine reopen_file(IO_handle, filename, vars, novars, fields, threading, tim if (domain_set) one_file = (thread == SINGLE_FILE) if (one_file) then - call open_file(IO_handle, filename, APPEND_FILE, threading=thread) + call IO_handle%open(filename, APPEND_FILE, threading=thread) else - call open_file(IO_handle, filename, APPEND_FILE, MOM_domain=Domain) + call IO_handle%open(filename, APPEND_FILE, MOM_domain=Domain) endif - if (.not.file_is_open(IO_handle)) return + if (.not. IO_handle%file_is_open()) return - call get_file_info(IO_handle, nvar=nvar) + call IO_handle%get_file_info(nvar=nvar) if (nvar == -1) then write (mesg,*) "Reopening file ",trim(filename)," apparently had ",nvar,& " variables. Clobbering and creating file with ",novars," instead." call MOM_error(WARNING,"MOM_io: "//mesg) - call create_file(IO_handle, filename, vars, novars, fields, threading, timeunit, & - G=G, dG=dG, GV=GV, extra_axes=extra_axes, global_atts=global_atts) + call create_MOM_file(IO_handle, filename, vars, novars, fields, & + threading, timeunit, G=G, dG=dG, GV=GV, extra_axes=extra_axes, & + global_atts=global_atts) elseif (nvar /= novars) then write (mesg,*) "Reopening file ",trim(filename)," with ",novars,& " variables instead of ",nvar,"." call MOM_error(FATAL,"MOM_io: "//mesg) endif - if (nvar > 0) call get_file_fields(IO_handle, fields(1:nvar)) - - ! Check for inconsistent field names... -! do i=1,nvar -! call get_field_atts(fields(i), name) -! !if (trim(name) /= trim(vars%name)) then -! ! write (mesg, '("Reopening file ",a," variable ",a," is called ",a,".")',& -! ! trim(filename), trim(vars%name), trim(name)) -! ! call MOM_error(NOTE, "MOM_io: "//trim(mesg)) -! !endif -! enddo + if (nvar > 0) call IO_handle%get_file_fields(fields(1:nvar)) endif +end subroutine reopen_MOM_file -end subroutine reopen_file !> Return the index of sdtout if called from the root PE, or 0 for other PEs. integer function stdout_if_root() @@ -757,11 +903,12 @@ end subroutine read_var_sizes subroutine read_variable_0d(filename, varname, var, ncid_in, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: varname !< The variable name of the data in the file - real, intent(inout) :: var !< The scalar into which to read the data + real, intent(inout) :: var !< The scalar into which to read the data in arbitrary units [A ~> a] integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the !! file is opened and closed within this routine - real, optional, intent(in) :: scale !< A scaling factor that the variable is - !! multiplied by before it is returned + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: varid, ncid, rc character(len=256) :: hdr @@ -794,11 +941,12 @@ end subroutine read_variable_0d subroutine read_variable_1d(filename, varname, var, ncid_in, scale) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: varname !< The variable name of the data in the file - real, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data + real, dimension(:), intent(inout) :: var !< The 1-d array into which to read the data in arbitrary units [A ~> a] integer, optional, intent(in) :: ncid_in !< The netCDF ID of an open file. If absent, the !! file is opened and closed within this routine - real, optional, intent(in) :: scale !< A scaling factor that the variable is - !! multiplied by before it is returned + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: varid, ncid, rc character(len=256) :: hdr @@ -914,7 +1062,7 @@ end subroutine read_variable_1d_int subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) character(len=*), intent(in) :: filename !< Name of file to be read character(len=*), intent(in) :: varname !< Name of variable to be read - real, intent(out) :: var(:,:) !< Output array of variable + real, intent(out) :: var(:,:) !< Output array of variable [arbitrary] integer, optional, intent(in) :: start(:) !< Starting index on each axis. integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. @@ -1247,7 +1395,7 @@ end subroutine read_attribute_int64 subroutine read_attribute_real(filename, attname, att_val, varname, found, all_read, ncid_in) character(len=*), intent(in) :: filename !< Name of the file to read character(len=*), intent(in) :: attname !< Name of the attribute to read - real, intent(out) :: att_val !< The value of the attribute + real, intent(out) :: att_val !< The value of the attribute [arbitrary] character(len=*), optional, intent(in) :: varname !< The name of the variable whose attribute will !! be read. If missing, read a global attribute. logical, optional, intent(out) :: found !< Returns true if the attribute is found @@ -1491,6 +1639,7 @@ function var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_na character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name real , optional, intent(in) :: conversion !< for unit conversions, such as needed to !! convert from intensive to extensive + !! [various] or [a A-1 ~> 1] character(len=*), optional, intent(in) :: caller !< The calling routine for error messages integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position !! of this variable if it has such dimensions. @@ -1543,6 +1692,7 @@ subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & real , optional, intent(in) :: conversion !< A multiplicative factor for unit conversions, !! such as needed to convert from intensive to !! extensive or dimensional consistency testing + !! [various] or [a A-1 ~> 1] character(len=*), optional, intent(in) :: caller !< The calling routine for error messages integer, optional, intent(in) :: position !< A coded integer indicating the horizontal position !! of this variable if it has such dimensions. @@ -1628,7 +1778,7 @@ subroutine set_axis_info(axis, name, units, longname, ax_size, ax_data, cartesia character(len=*), optional, intent(in) :: units !< The units of the axis labels character(len=*), optional, intent(in) :: longname !< Long name of the axis variable integer, optional, intent(in) :: ax_size !< The number of elements in this axis - real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis + real, dimension(:), optional, intent(in) :: ax_data !< The values of the data on the axis [arbitrary] character(len=*), optional, intent(in) :: cartesian !< A variable indicating which direction this axis !! axis corresponds with. Valid values !! include 'X', 'Y', 'Z', 'T', and 'N' (the default) for none. @@ -1688,7 +1838,7 @@ subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) character(len=*), intent(out), optional :: cartesian !< The cartesian attribute !! of the axis [X,Y,Z,T]. integer, intent(out), optional :: ax_size !< The size of the axis. - real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. + real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data [arbitrary] if (present(ax_data)) then if (allocated(ax_data)) deallocate(ax_data) @@ -1758,6 +1908,7 @@ subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & character(len=*), optional, intent(out) :: cmor_longname !< CMOR long name real , optional, intent(out) :: conversion !< for unit conversions, such as needed to !! convert from intensive to extensive + !! [various] or [a A-1 ~> 1] character(len=*), optional, intent(in) :: caller !< calling routine? integer, optional, intent(out) :: position !< A coded integer indicating the horizontal position !! of this variable if it has such dimensions. @@ -1808,9 +1959,11 @@ subroutine MOM_read_data_0d(filename, fieldname, data, timelevel, scale, MOM_Dom 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 + real, intent(inout) :: data !< Field value in arbitrary units [A ~> a] integer, optional, intent(in) :: timelevel !< Time level to read in file - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] 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 @@ -1839,9 +1992,11 @@ subroutine MOM_read_data_1d(filename, fieldname, data, timelevel, scale, MOM_Dom 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 + real, dimension(:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] integer, optional, intent(in) :: timelevel !< Time level to read in file - real, optional, intent(in) :: scale !< Rescale factor + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] 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 @@ -1870,17 +2025,19 @@ 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 + real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] 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 + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] 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 + real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a] turns = MOM_domain%turns if (turns == 0) then @@ -1900,12 +2057,66 @@ subroutine MOM_read_data_2d(filename, fieldname, data, MOM_Domain, & end subroutine MOM_read_data_2d +!> Read a 2d array (which might have halos) from a file using native netCDF I/O. +subroutine read_netCDF_data_2d(filename, fieldname, values, MOM_Domain, & + timelevel, position, rescale) + character(len=*), intent(in) :: filename + !< Input filename + character(len=*), intent(in) :: fieldname + !< Field variable name + real, intent(inout) :: values(:,:) + !< Field values read from the file. It would be intent(out) but for the + !! need to preserve any initialized values in the halo regions. + 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) :: rescale + !< Rescale factor, omitting this is the same as setting it to 1. + + integer :: turns + ! Number of quarter-turns from input to model grid + real, allocatable :: values_in(:,:) + ! Field array on the unrotated input grid + type(MOM_netcdf_file) :: handle + ! netCDF file handle + + ! General-purpose IO will require the following arguments, but they are not + ! yet implemented, so we raise an error if they are present. + + ! Fields are currently assumed on cell centers, and position is unsupported + if (present(position)) & + call MOM_error(FATAL, 'read_netCDF_data: position is not yet supported.') + + ! Timelevels are not yet supported + if (present(timelevel)) & + call MOM_error(FATAL, 'read_netCDF_data: timelevel is not yet supported.') + + call handle%open(filename, action=READONLY_FILE, MOM_domain=MOM_domain) + call handle%update() + + turns = MOM_domain%turns + if (turns == 0) then + call handle%read(fieldname, values, rescale=rescale) + else + call allocate_rotated_array(values, [1,1], -turns, values_in) + call handle%read(fieldname, values_in, rescale=rescale) + call rotate_array(values_in, turns, values) + deallocate(values_in) + endif + + call handle%close() +end subroutine read_netCDF_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 + real, dimension(:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] 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. @@ -1913,12 +2124,14 @@ subroutine MOM_read_data_2d_region(filename, fieldname, data, start, nread, MOM_ 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 + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] 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 + real, allocatable :: data_in(:,:) ! Field array on the input grid in arbitrary units [A ~> a] qturns = 0 if (present(turns)) qturns = modulo(turns, 4) @@ -1943,17 +2156,19 @@ 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 + real, dimension(:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] 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 + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] 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 + real, allocatable :: data_in(:,:,:) ! Field array on the input grid in arbitrary units [A ~> a] turns = MOM_domain%turns if (turns == 0) then @@ -1978,15 +2193,17 @@ 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 + real, dimension(:,:,:,:), intent(inout) :: data !< Field value in arbitrary units [A ~> a] 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 + real, optional, intent(in) :: scale !< A scaling factor that the variable is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] 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 + real, allocatable :: data_in(:,:,:,:) ! Field array on the input grid in arbitrary units [A ~> a] turns = MOM_domain%turns @@ -2014,16 +2231,18 @@ subroutine MOM_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data 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 + real, dimension(:,:), intent(inout) :: u_data !< Field value at u points in arbitrary units [A ~> a] + real, dimension(:,:), intent(inout) :: v_data !< Field value at v points in arbitrary units [A ~> a] 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 + real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid + real, allocatable :: u_data_in(:,:), v_data_in(:,:) ! [uv] on the input grid in arbitrary units [A ~> a] turns = MOM_Domain%turns if (turns == 0) then @@ -2055,16 +2274,18 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data 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 + real, dimension(:,:,:), intent(inout) :: u_data !< Field value in u in arbitrary units [A ~> a] + real, dimension(:,:,:), intent(inout) :: v_data !< Field value in v in arbitrary units [A ~> a] 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 + real, optional, intent(in) :: scale !< A scaling factor that the vector is multiplied by + !! before it is returned to convert from the units in the file + !! to the internal units for this variable [A a-1 ~> 1] integer :: turns ! Number of quarter-turns from input to model grid - real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid + real, allocatable :: u_data_in(:,:,:), v_data_in(:,:,:) ! [uv] on the input grid in arbitrary units [A ~> a] turns = MOM_Domain%turns if (turns == 0) then @@ -2089,13 +2310,178 @@ subroutine MOM_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data 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, & +subroutine MOM_write_field_legacy_4d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing type(fieldtype), intent(in) :: field_md !< Field type with metadata type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a] + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output + + real, allocatable :: field_rot(:,:,:,:) ! A rotated version of field, with the same units [a] or + ! rescaled [A ~> a] then [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if ((qturns == 0) .and. (scale_fac == 1.0)) then + call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + else + call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) + call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_legacy_4d + + +!> Write a 3d field to an output file, potentially with rotation +subroutine MOM_write_field_legacy_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns, scale) + type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(fieldtype), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value in the units used in the file [a] + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output + + + real, allocatable :: field_rot(:,:,:) ! A rotated version of field, with the same units [a] or + ! rescaled [A ~> a] then [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if ((qturns == 0) .and. (scale_fac == 1.0)) then + call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + else + call allocate_rotated_array(field, [1,1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) + call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_legacy_3d + + +!> Write a 2d field to an output file, potentially with rotation +subroutine MOM_write_field_legacy_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & + fill_value, turns, scale) + type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(fieldtype), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field !< Unrotated field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value !< Missing data fill value + integer, optional, intent(in) :: turns !< Number of quarter-turns to rotate the data + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output + + + real, allocatable :: field_rot(:,:) ! A rotated version of field, with the same units [a] or + ! rescaled [A ~> a] then [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] + integer :: qturns ! The number of quarter turns through which to rotate field + + qturns = 0 ; if (present(turns)) qturns = modulo(turns, 4) + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if ((qturns == 0) .and. (scale_fac == 1.0)) then + call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + else + call allocate_rotated_array(field, [1,1], qturns, field_rot) + call rotate_array(field, qturns, field_rot) + if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) + call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, & + tile_count=tile_count, fill_value=fill_value) + deallocate(field_rot) + endif +end subroutine MOM_write_field_legacy_2d + + +!> Write a 1d field to an output file +subroutine MOM_write_field_legacy_1d(IO_handle, field_md, field, tstamp, fill_value, scale) + type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(fieldtype), intent(in) :: field_md !< Field type with metadata + real, dimension(:), intent(in) :: field !< Field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + real, optional, intent(in) :: fill_value !< Missing data fill value [a] + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output + + + real, dimension(:), allocatable :: array ! A rescaled copy of field [a] + real :: scale_fac ! A scaling factor to use before writing the array [a A-1 ~> 1] + integer :: i + + scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + + if (scale_fac == 1.0) then + call write_field(IO_handle, field_md, field, tstamp=tstamp) + else + allocate(array(size(field))) + array(:) = scale_fac * field(:) + if (present(fill_value)) then + do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo + endif + call write_field(IO_handle, field_md, array, tstamp=tstamp) + deallocate(array) + endif +end subroutine MOM_write_field_legacy_1d + + +!> Write a 0d field to an output file +subroutine MOM_write_field_legacy_0d(IO_handle, field_md, field, tstamp, fill_value, scale) + type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(fieldtype), intent(in) :: field_md !< Field type with metadata + real, intent(in) :: field !< Field to write in arbitrary units [A ~> a] + real, optional, intent(in) :: tstamp !< Model timestamp, often in [days] + real, optional, intent(in) :: fill_value !< Missing data fill value [a] + real, optional, intent(in) :: scale !< A scaling factor that the field is multiplied by before + !! it is written [a A-1 ~> 1], for example to convert it + !! from its internal units to the desired units for output + + real :: scaled_val ! A rescaled copy of field [a] + + scaled_val = field + if (present(scale)) scaled_val = scale*field + if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif + + call write_field(IO_handle, field_md, scaled_val, tstamp=tstamp) +end subroutine MOM_write_field_legacy_0d + + +!> 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) + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition real, dimension(:,:,:,:), intent(inout) :: field !< Unrotated field to write real, optional, intent(in) :: tstamp !< Model timestamp integer, optional, intent(in) :: tile_count !< PEs per tile (default: 1) @@ -2112,13 +2498,13 @@ subroutine MOM_write_field_4d(IO_handle, field_md, MOM_domain, field, tstamp, ti scale_fac = 1.0 ; if (present(scale)) scale_fac = scale if ((qturns == 0) .and. (scale_fac == 1.0)) then - call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, & + call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, & tile_count=tile_count, fill_value=fill_value) else call allocate_rotated_array(field, [1,1,1,1], qturns, field_rot) call rotate_array(field, qturns, field_rot) if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) - call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, & + call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, & tile_count=tile_count, fill_value=fill_value) deallocate(field_rot) endif @@ -2127,8 +2513,8 @@ end subroutine MOM_write_field_4d !> Write a 3d field to an output file, potentially with rotation subroutine MOM_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) - type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing - type(fieldtype), intent(in) :: field_md !< Field type with metadata + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition real, dimension(:,:,:), intent(inout) :: field !< Unrotated field to write real, optional, intent(in) :: tstamp !< Model timestamp @@ -2146,13 +2532,13 @@ subroutine MOM_write_field_3d(IO_handle, field_md, MOM_domain, field, tstamp, ti scale_fac = 1.0 ; if (present(scale)) scale_fac = scale if ((qturns == 0) .and. (scale_fac == 1.0)) then - call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, & + call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, & tile_count=tile_count, fill_value=fill_value) else call allocate_rotated_array(field, [1,1,1], qturns, field_rot) call rotate_array(field, qturns, field_rot) if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) - call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, & + call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, & tile_count=tile_count, fill_value=fill_value) deallocate(field_rot) endif @@ -2161,8 +2547,8 @@ end subroutine MOM_write_field_3d !> Write a 2d field to an output file, potentially with rotation subroutine MOM_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, tile_count, & fill_value, turns, scale) - type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing - type(fieldtype), intent(in) :: field_md !< Field type with metadata + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata type(MOM_domain_type), intent(in) :: MOM_domain !< The MOM_Domain that describes the decomposition real, dimension(:,:), intent(inout) :: field !< Unrotated field to write real, optional, intent(in) :: tstamp !< Model timestamp @@ -2180,13 +2566,13 @@ subroutine MOM_write_field_2d(IO_handle, field_md, MOM_domain, field, tstamp, ti scale_fac = 1.0 ; if (present(scale)) scale_fac = scale if ((qturns == 0) .and. (scale_fac == 1.0)) then - call write_field(IO_handle, field_md, MOM_domain, field, tstamp=tstamp, & + call IO_handle%write_field(field_md, MOM_domain, field, tstamp=tstamp, & tile_count=tile_count, fill_value=fill_value) else call allocate_rotated_array(field, [1,1], qturns, field_rot) call rotate_array(field, qturns, field_rot) if (scale_fac /= 1.0) call rescale_comp_data(MOM_Domain, field_rot, scale_fac) - call write_field(IO_handle, field_md, MOM_domain, field_rot, tstamp=tstamp, & + call IO_handle%write_field(field_md, MOM_domain, field_rot, tstamp=tstamp, & tile_count=tile_count, fill_value=fill_value) deallocate(field_rot) endif @@ -2194,8 +2580,8 @@ end subroutine MOM_write_field_2d !> Write a 1d field to an output file subroutine MOM_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, scale) - type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing - type(fieldtype), intent(in) :: field_md !< Field type with metadata + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata real, dimension(:), intent(in) :: field !< Field to write real, optional, intent(in) :: tstamp !< Model timestamp real, optional, intent(in) :: fill_value !< Missing data fill value @@ -2209,22 +2595,22 @@ subroutine MOM_write_field_1d(IO_handle, field_md, field, tstamp, fill_value, sc scale_fac = 1.0 ; if (present(scale)) scale_fac = scale if (scale_fac == 1.0) then - call write_field(IO_handle, field_md, field, tstamp=tstamp) + call IO_handle%write_field(field_md, field, tstamp=tstamp) else allocate(array(size(field))) array(:) = scale_fac * field(:) if (present(fill_value)) then do i=1,size(field) ; if (field(i) == fill_value) array(i) = fill_value ; enddo endif - call write_field(IO_handle, field_md, array, tstamp=tstamp) + call IO_handle%write_field(field_md, array, tstamp=tstamp) deallocate(array) endif end subroutine MOM_write_field_1d !> Write a 0d field to an output file subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, scale) - type(file_type), intent(inout) :: IO_handle !< Handle for a file that is open for writing - type(fieldtype), intent(in) :: field_md !< Field type with metadata + class(MOM_file), intent(inout) :: IO_handle !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md !< Field type with metadata real, intent(in) :: field !< Field to write real, optional, intent(in) :: tstamp !< Model timestamp real, optional, intent(in) :: fill_value !< Missing data fill value @@ -2236,7 +2622,7 @@ subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, sc if (present(scale)) scaled_val = scale*field if (present(fill_value)) then ; if (field == fill_value) scaled_val = fill_value ; endif - call write_field(IO_handle, field_md, scaled_val, tstamp=tstamp) + call IO_handle%write_field(field_md, scaled_val, tstamp=tstamp) end subroutine MOM_write_field_0d !> Given filename and fieldname, this subroutine returns the size of the field in the file @@ -2407,9 +2793,9 @@ subroutine get_var_axes_info(filename, fieldname, axes_info) character(len=128) :: dim_name(4) integer, dimension(1) :: start, count !! cartesian axis data - real, allocatable, dimension(:) :: x - real, allocatable, dimension(:) :: y - real, allocatable, dimension(:) :: z + real, allocatable, dimension(:) :: x ! x-axis labels, often [degrees_E] or [km] or [m] + real, allocatable, dimension(:) :: y ! y-axis labels, often [degrees_N] or [km] or [m] + real, allocatable, dimension(:) :: z ! vertical axis labels [various], often [m] or [kg m-3] call open_file_to_read(filename, ncid, success=success) diff --git a/src/framework/MOM_io_file.F90 b/src/framework/MOM_io_file.F90 new file mode 100644 index 0000000000..e1613fbbb3 --- /dev/null +++ b/src/framework/MOM_io_file.F90 @@ -0,0 +1,1793 @@ +!> This module contains the MOM file handler types +module MOM_io_file + +! This file is part of MOM6. See LICENSE.md for the license. + +use, intrinsic :: iso_fortran_env, only : int64 + +use MOM_domains, only : MOM_domain_type, domain1D +use MOM_io_infra, only : file_type, get_file_info, get_file_fields +use MOM_io_infra, only : open_file, close_file, flush_file +use MOM_io_infra, only : fms2_file_is_open => file_is_open +use MOM_io_infra, only : fieldtype +use MOM_io_infra, only : get_file_times, axistype +use MOM_io_infra, only : write_field, write_metadata +use MOM_io_infra, only : get_field_atts +use MOM_io_infra, only : read_field_chksum + +use MOM_hor_index, only : hor_index_type +use MOM_hor_index, only : hor_index_init + +use MOM_netcdf, only : netcdf_file_type +use MOM_netcdf, only : netcdf_axis +use MOM_netcdf, only : netcdf_field +use MOM_netcdf, only : open_netcdf_file +use MOM_netcdf, only : close_netcdf_file +use MOM_netcdf, only : flush_netcdf_file +use MOM_netcdf, only : register_netcdf_axis +use MOM_netcdf, only : register_netcdf_field +use MOM_netcdf, only : write_netcdf_field +use MOM_netcdf, only : write_netcdf_axis +use MOM_netcdf, only : write_netcdf_attribute +use MOM_netcdf, only : get_netcdf_size +use MOM_netcdf, only : get_netcdf_fields +use MOM_netcdf, only : read_netcdf_field + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_error_handler, only : is_root_PE + +implicit none ; private + +public :: MOM_file +public :: MOM_infra_file +public :: MOM_netcdf_file +public :: MOM_axis +public :: MOM_field + + +! Internal types + +! NOTE: MOM_axis and MOM_field do not contain the actual axes and fields stored +! in the file. They are very thin wrappers to the keys (as strings) used to +! reference the associated object inside of the MOM_file. + +!> Handle for axis in MOM file +type :: MOM_axis + character(len=:), allocatable :: label + !< Identifier for the axis in handle's list +end type MOM_axis + + +!> Linked list of framework axes +type :: axis_list_infra + private + type(axis_node_infra), pointer :: head => null() + !< Head of axis linked list + type(axis_node_infra), pointer :: tail => null() + !< Tail of axis linked list +contains + !> Initialize the framework axis list + procedure :: init => initialize_axis_list_infra + !> Append a new axis to the framework axis list + procedure :: append => append_axis_list_infra + !> Get an axis from the framework axis list + procedure :: get => get_axis_list_infra + !> Deallocate the framework axis list + procedure :: finalize => finalize_axis_list_infra +end type axis_list_infra + + +!> Framework axis linked list node +type :: axis_node_infra + private + character(len=:), allocatable :: label + !< Axis identifier + type(axis_node_infra), pointer :: next => null() + !< Pointer to next axis node + type(axistype) :: axis + !< Axis node contents +end type axis_node_infra + + +!> Linked list of framework axes +type :: axis_list_nc + private + type(axis_node_nc), pointer :: head => null() + !< Head of axis linked list + type(axis_node_nc), pointer :: tail => null() + !< Tail of axis linked list +contains + !> Initialize the netCDF axis list + procedure :: init => initialize_axis_list_nc + !> Append a new axis to the netCDF axis list + procedure :: append => append_axis_list_nc + !> Get an axis from the netCDF axis list + procedure :: get => get_axis_list_nc + !> Deallocate the netCDF axis list + procedure :: finalize => finalize_axis_list_nc +end type axis_list_nc + + +!> Framework axis linked list node +type :: axis_node_nc + private + character(len=:), allocatable :: label + !< Axis identifier + type(axis_node_nc), pointer :: next => null() + !< Pointer to next axis node + type(netcdf_axis) :: axis + !< Axis node contents +end type axis_node_nc + + +!> Handle for field in MOM file +type :: MOM_field + character(len=:), allocatable :: label + !< Identifier for the field in the handle's list +end type MOM_field + + +!> Linked list of framework fields +type :: field_list_infra + private + type(field_node_infra), pointer :: head => null() + !< Head of field linked list + type(field_node_infra), pointer :: tail => null() + !< Tail of field linked list +contains + !> Initialize the framework field list + procedure :: init => initialize_field_list_infra + !> Append a new axis to the framework field list + procedure :: append => append_field_list_infra + !> Get an axis from the framework field list + procedure :: get => get_field_list_infra + !> Deallocate the framework field list + procedure :: finalize => finalize_field_list_infra +end type field_list_infra + + +!> Framework field linked list node +type :: field_node_infra + private + character(len=:), allocatable :: label + !< Field identifier + type(fieldtype) :: field + !< Field node contents + type(field_node_infra), pointer :: next => null() + !< Pointer to next field node +end type field_node_infra + + +!> Linked list of framework fields +type :: field_list_nc + private + type(field_node_nc), pointer :: head => null() + !< Head of field linked list + type(field_node_nc), pointer :: tail => null() + !< Tail of field linked list +contains + !> Initialize the netCDF field list + procedure :: init => initialize_field_list_nc + !> Append a new axis to the netCDF field list + procedure :: append => append_field_list_nc + !> Get an axis from the netCDF field list + procedure :: get => get_field_list_nc + !> Deallocate the netCDF field list + procedure :: finalize => finalize_field_list_nc +end type field_list_nc + + +!> Framework field linked list node +type :: field_node_nc + private + character(len=:), allocatable :: label + !< Field identifier + type(netcdf_field) :: field + !< Field node contents + type(field_node_nc), pointer :: next => null() + !< Pointer to next field node +end type field_node_nc + + +!> Generic MOM file abstraction for common operations +type, abstract :: MOM_file + private + + contains + + !> Open a file and connect to the MOM_file object + procedure(i_open_file), deferred :: open + !> Close the MOM file + procedure(i_close_file), deferred :: close + !> Flush buffered output to the MOM file + procedure(i_flush_file), deferred :: flush + + !> Register an axis to the MOM file + procedure(i_register_axis), deferred :: register_axis + !> Register a field to the MOM file + procedure(i_register_field), deferred :: register_field + !> Write metadata to the MOM file + procedure(i_write_attribute), deferred :: write_attribute + + !> Write field to a MOM file + generic :: write_field => & + write_field_4d, & + write_field_3d, & + write_field_2d, & + write_field_1d, & + write_field_0d, & + write_field_axis + + !> Write a 4D field to the MOM file + procedure(i_write_field_4d), deferred :: write_field_4d + !> Write a 3D field to the MOM file + procedure(i_write_field_3d), deferred :: write_field_3d + !> Write a 2D field to the MOM file + procedure(i_write_field_2d), deferred :: write_field_2d + !> Write a 1D field to the MOM file + procedure(i_write_field_1d), deferred :: write_field_1d + !> Write a 0D field to the MOM file + procedure(i_write_field_0d), deferred :: write_field_0d + !> Write an axis field to the MOM file + procedure(i_write_field_axis), deferred :: write_field_axis + + !> Return true if MOM file has been opened + procedure(i_file_is_open), deferred :: file_is_open + !> Return number of dimensions, variables, or time levels in a MOM file + procedure(i_get_file_info), deferred :: get_file_info + !> Get field objects from a MOM file + procedure(i_get_file_fields), deferred :: get_file_fields + !> Get attributes from a field + procedure(i_get_field_atts), deferred :: get_field_atts + !> Get checksum from a field + procedure(i_read_field_chksum), deferred :: read_field_chksum +end type MOM_file + + +!> MOM file from the supporting framework ("infra") layer +type, extends(MOM_file) :: MOM_infra_file + private + + ! NOTE: This will be made private after the API transition + type(file_type), public :: handle_infra + !< Framework-specific file handler content + type(axis_list_infra) :: axes + !< List of axes in file + type(field_list_infra) :: fields + !< List of fields in file + + contains + + !> Open a framework file and connect to the MOM_file object + procedure :: open => open_file_infra + !> Close the MOM framework file + procedure :: close => close_file_infra + !> Flush buffered output to the MOM framework file + procedure :: flush => flush_file_infra + + !> Register an axis to the MOM framework file + procedure :: register_axis => register_axis_infra + !> Register a field to the MOM framework file + procedure :: register_field => register_field_infra + !> Write global metadata to the MOM framework file + procedure :: write_attribute => write_attribute_infra + + !> Write a 4D field to the MOM framework file + procedure :: write_field_4d => write_field_4d_infra + !> Write a 3D field to the MOM framework file + procedure :: write_field_3d => write_field_3d_infra + !> Write a 2D field to the MOM framework file + procedure :: write_field_2d => write_field_2d_infra + !> Write a 1D field to the MOM framework file + procedure :: write_field_1d => write_field_1d_infra + !> Write a 0D field to the MOM framework file + procedure :: write_field_0d => write_field_0d_infra + !> Write an axis field to the MOM framework file + procedure :: write_field_axis => write_field_axis_infra + + !> Return true if MOM infra file has been opened + procedure :: file_is_open => file_is_open_infra + !> Return number of dimensions, variables, or time levels in a MOM infra file + procedure :: get_file_info => get_file_info_infra + !> Get field metadata from a MOM infra file + procedure :: get_file_fields => get_file_fields_infra + !> Get attributes from a field + procedure :: get_field_atts => get_field_atts_infra + !> Get checksum from a field + procedure :: read_field_chksum => read_field_chksum_infra + + ! MOM_infra_file methods + ! NOTE: These could naturally reside in MOM_file but is currently not needed. + + !> Get time levels of a MOM framework file + procedure :: get_file_times => get_file_times_infra + + !> Get the fields as fieldtypes from a file + procedure :: get_file_fieldtypes + ! NOTE: This is provided to support the legacy API and may be removed. +end type MOM_infra_file + + +!> MOM file using netCDF backend +type, extends(MOM_file) :: MOM_netcdf_file + private + + !> Framework-specific file handler content + type(netcdf_file_type) :: handle_nc + !> List of netCDF axes + type(axis_list_nc) :: axes + !> List of netCDF fields + type(field_list_nc) :: fields + !> True if the file has been opened + logical :: is_open = .false. + !> True if I/O content is domain-decomposed + logical :: domain_decomposed = .false. + !> True if I/O content is domain-decomposed + type(hor_index_type) :: HI + + contains + + !> Open a framework file and connect to the MOM_netcdf_file object + procedure :: open => open_file_nc + !> Close the MOM netcdf file + procedure :: close => close_file_nc + !> Flush buffered output to the MOM netcdf file + procedure :: flush => flush_file_nc + + !> Register an axis to the MOM netcdf file + procedure :: register_axis => register_axis_nc + !> Register a field to the MOM netcdf file + procedure :: register_field => register_field_nc + !> Write global metadata to the MOM netcdf file + procedure :: write_attribute => write_attribute_nc + + !> Write a 4D field to the MOM netcdf file + procedure :: write_field_4d => write_field_4d_nc + !> Write a 3D field to the MOM netcdf file + procedure :: write_field_3d => write_field_3d_nc + !> Write a 2D field to the MOM netcdf file + procedure :: write_field_2d => write_field_2d_nc + !> Write a 1D field to the MOM netcdf file + procedure :: write_field_1d => write_field_1d_nc + !> Write a 0D field to the MOM netcdf file + procedure :: write_field_0d => write_field_0d_nc + !> Write an axis field to the MOM netcdf file + procedure :: write_field_axis => write_field_axis_nc + + !> Return true if MOM netcdf file has been opened + procedure :: file_is_open => file_is_open_nc + !> Return number of dimensions, variables, or time levels in a MOM netcdf file + procedure :: get_file_info => get_file_info_nc + !> Get field metadata from a MOM netcdf file + procedure :: get_file_fields => get_file_fields_nc + !> Get attributes from a netCDF field + procedure :: get_field_atts => get_field_atts_nc + !> Get checksum from a netCDF field + procedure :: read_field_chksum => read_field_chksum_nc + + ! NOTE: These are currently exclusive to netCDF I/O but could be generalized + !> Read the values of a netCDF field + procedure :: read => get_field_nc + !> Update the axes and fields descriptors of a MOM netCDF file + procedure :: update => update_file_contents_nc +end type MOM_netcdf_file + + +interface + !> Interface for opening a MOM file + subroutine i_open_file(handle, filename, action, MOM_domain, threading, fileset) + import :: MOM_file, MOM_domain_type + + class(MOM_file), intent(inout) :: handle + !< The handle for the opened file + character(len=*), intent(in) :: filename + !< The path name of the file being opened + integer, optional, intent(in) :: action + !< A flag indicating whether the file can be read or written to and how + !! to handle existing files. The default is WRITE_ONLY. + type(MOM_domain_type), optional, intent(in) :: MOM_Domain + !< A MOM_Domain that describes the decomposition + integer, optional, intent(in) :: threading + !< A flag indicating whether one (SINGLE_FILE) or multiple PEs (MULTIPLE) + !! participate in I/O. With the default, the root PE does I/O. + integer, optional, intent(in) :: fileset + !< A flag indicating whether multiple PEs doing I/O due to + !! threading=MULTIPLE write to the same file (SINGLE_FILE) or to one file + !! per PE (MULTIPLE, the default). + end subroutine i_open_file + + + !> Interface for closing a MOM file + subroutine i_close_file(handle) + import :: MOM_file + class(MOM_file), intent(inout) :: handle + !< The MOM file to be closed + end subroutine i_close_file + + + !> Interface for flushing I/O in a MOM file + subroutine i_flush_file(handle) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< The MOM file to be flushed + end subroutine i_flush_file + + + !> Interface to register an axis to a MOM file + function i_register_axis(handle, label, units, longname, cartesian, sense, & + domain, data, edge_axis, calendar) result(axis) + import :: MOM_file, MOM_axis, domain1D + + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: label + !< The name in the file of this axis + character(len=*), intent(in) :: units + !< The units of this axis + character(len=*), intent(in) :: longname + !< The long description of this axis + character(len=*), optional, intent(in) :: cartesian + !< A variable indicating which direction this axis corresponds with. + !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer, optional, intent(in) :: sense + !< This is 1 for axes whose values increase upward, or -1 if they + !! increase downward. + type(domain1D), optional, intent(in) :: domain + !< The domain decomposion for this axis + real, dimension(:), optional, intent(in) :: data + !< The coordinate values of the points on this axis + logical, optional, intent(in) :: edge_axis + !< If true, this axis marks an edge of the tracer cells + character(len=*), optional, intent(in) :: calendar + !< The name of the calendar used with a time axis + type(MOM_axis) :: axis + !< IO handle for axis in MOM_file + end function i_register_axis + + + !> Interface to register a field to a netCDF file + function i_register_field(handle, axes, label, units, longname, & + pack, standard_name, checksum) result(field) + import :: MOM_file, MOM_axis, MOM_field, int64 + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axes(:) + !< Handles for the axis used for this variable + character(len=*), intent(in) :: label + !< The name in the file of this variable + character(len=*), intent(in) :: units + !< The units of this variable + character(len=*), intent(in) :: longname + !< The long description of this variable + integer, optional, intent(in) :: pack + !< A precision reduction factor with which the variable. The default, 1, + !! has no reduction, but 2 is not uncommon. + character(len=*), optional, intent(in) :: standard_name + !< The standard (e.g., CMOR) name for this variable + integer(kind=int64), dimension(:), optional, intent(in) :: checksum + !< Checksum values that can be used to verify reads. + type(MOM_field) :: field + !< IO handle for field in MOM_file + end function i_register_field + + + !> Interface for writing global metata to a MOM file + subroutine i_write_attribute(handle, name, attribute) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: name + !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute + !< The value of this attribute + end subroutine i_write_attribute + + + !> Interface to write_field_4d() + subroutine i_write_field_4d(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + import :: MOM_file, MOM_field, MOM_domain_type + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + end subroutine i_write_field_4d + + + !> Interface to write_field_3d() + subroutine i_write_field_3d(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + import :: MOM_file, MOM_field, MOM_domain_type + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + end subroutine i_write_field_3d + + + !> Interface to write_field_2d() + subroutine i_write_field_2d(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + import :: MOM_file, MOM_field, MOM_domain_type + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + end subroutine i_write_field_2d + + + !> Interface to write_field_1d() + subroutine i_write_field_1d(handle, field_md, field, tstamp) + import :: MOM_file, MOM_field + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, dimension(:), intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + end subroutine i_write_field_1d + + + !> Interface to write_field_0d() + subroutine i_write_field_0d(handle, field_md, field, tstamp) + import :: MOM_file, MOM_field + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + end subroutine i_write_field_0d + + + !> Interface to write_field_axis() + subroutine i_write_field_axis(handle, axis) + import :: MOM_file, MOM_axis + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axis + !< An axis type variable with information to write + end subroutine i_write_field_axis + + + !> Interface to file_is_open() + logical function i_file_is_open(handle) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< Handle to a file to inquire about + end function i_file_is_open + + + !> Interface to get_file_info() + subroutine i_get_file_info(handle, ndim, nvar, ntime) + import :: MOM_file + class(MOM_file), intent(in) :: handle + !< Handle for a file that is open for I/O + integer, optional, intent(out) :: ndim + !< The number of dimensions in the file + integer, optional, intent(out) :: nvar + !< The number of variables in the file + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + end subroutine i_get_file_info + + + !> Interface to get_file_fields() + subroutine i_get_file_fields(handle, fields) + import :: MOM_file, MOM_field + class(MOM_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), dimension(:), intent(inout) :: fields + !< Field-type descriptions of all of the variables in a file. + end subroutine i_get_file_fields + + + !> Interface to get_field_atts() + subroutine i_get_field_atts(handle, field, name, units, longname, checksum) + import :: MOM_file, MOM_field, int64 + class(MOM_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field to extract information from + character(len=*), optional, intent(out) :: name + !< The variable name + character(len=*), optional, intent(out) :: units + !< The units of the variable + character(len=*), optional, intent(out) :: longname + !< The long name of the variable + integer(kind=int64), optional, intent(out) :: checksum(:) + !< The checksums of the variable in a file + end subroutine i_get_field_atts + + + !> Interface to read_field_chksum + subroutine i_read_field_chksum(handle, field, chksum, valid_chksum) + import :: MOM_file, MOM_field, int64 + class(MOM_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field whose checksum attribute is to be read + integer(kind=int64), intent(out) :: chksum + !< The checksum for the field. + logical, intent(out) :: valid_chksum + !< If true, chksum has been successfully read + end subroutine i_read_field_chksum +end interface + +contains + +!> Initialize the linked list of framework axes +subroutine initialize_axis_list_infra(list) + class(axis_list_infra), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_axis_list_infra + + +!> Append a new axis to the list +subroutine append_axis_list_infra(list, axis, label) + class(axis_list_infra), intent(inout) :: list + type(axistype), intent(in) :: axis + character(len=*), intent(in) :: label + + type(axis_node_infra), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%axis = axis + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_axis_list_infra + + +!> Get axis based on label +function get_axis_list_infra(list, label) result(axis) + class(axis_list_infra), intent(in) :: list + character(len=*), intent(in) :: label + type(axistype) :: axis + + type(axis_node_infra), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "axis associated with " // label // " not found.") + + axis = node%axis +end function get_axis_list_infra + + +!> Deallocate axes of list +subroutine finalize_axis_list_infra(list) + class(axis_list_infra), intent(inout) :: list + + type(axis_node_infra), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_axis_list_infra + + +!> Initialize the linked list of framework axes +subroutine initialize_axis_list_nc(list) + class(axis_list_nc), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_axis_list_nc + + +!> Append a new axis to the list +subroutine append_axis_list_nc(list, axis, label) + class(axis_list_nc), intent(inout) :: list + type(netcdf_axis), intent(in) :: axis + character(len=*), intent(in) :: label + + type(axis_node_nc), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%axis = axis + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_axis_list_nc + + +!> Get axis based on label +function get_axis_list_nc(list, label) result(axis) + class(axis_list_nc), intent(in) :: list + character(len=*), intent(in) :: label + type(netcdf_axis) :: axis + + type(axis_node_nc), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "axis associated with " // label // " not found.") + + axis = node%axis +end function get_axis_list_nc + + +!> Deallocate axes of list +subroutine finalize_axis_list_nc(list) + class(axis_list_nc), intent(inout) :: list + + type(axis_node_nc), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_axis_list_nc + + +!> Initialize the linked list of framework axes +subroutine initialize_field_list_infra(list) + class(field_list_infra), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_field_list_infra + + +!> Append a new field to the list +subroutine append_field_list_infra(list, field, label) + class(field_list_infra), intent(inout) :: list + type(fieldtype), intent(in) :: field + character(len=*), intent(in) :: label + + type(field_node_infra), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%field = field + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_field_list_infra + + +!> Get axis based on label +function get_field_list_infra(list, label) result(field) + class(field_list_infra), intent(in) :: list + character(len=*), intent(in) :: label + type(fieldtype) :: field + + type(field_node_infra), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "field associated with " // label // " not found.") + + field = node%field +end function get_field_list_infra + + +!> Deallocate fields of list +subroutine finalize_field_list_infra(list) + class(field_list_infra), intent(inout) :: list + + type(field_node_infra), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_field_list_infra + + +!> Initialize the linked list of framework axes +subroutine initialize_field_list_nc(list) + class(field_list_nc), intent(inout) :: list + + ! Pre-allocate the first node and set the tail to this empty node + allocate(list%head) + list%tail => list%head +end subroutine initialize_field_list_nc + + +!> Append a new field to the list +subroutine append_field_list_nc(list, field, label) + class(field_list_nc), intent(inout) :: list + type(netcdf_field), intent(in) :: field + character(len=*), intent(in) :: label + + type(field_node_nc), pointer :: empty_node + + ! Transfer value to tail + list%tail%label = label + list%tail%field = field + + ! Extend list to next empty node + allocate(empty_node) + list%tail%next => empty_node + list%tail => empty_node +end subroutine append_field_list_nc + + +!> Get axis based on label +function get_field_list_nc(list, label) result(field) + class(field_list_nc), intent(in) :: list + character(len=*), intent(in) :: label + type(netcdf_field) :: field + + type(field_node_nc), pointer :: node + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => list%head + do while(associated(node%next)) + if (node%label == label) exit + node => node%next + enddo + if (.not. associated(node)) & + call MOM_error(FATAL, "field associated with " // label // " not found.") + + field = node%field +end function get_field_list_nc + + +!> Deallocate fields of list +subroutine finalize_field_list_nc(list) + class(field_list_nc), intent(inout) :: list + + type(field_node_nc), pointer :: node, next_node + + node => list%head + do while(associated(node)) + next_node => node + node => node%next + deallocate(next_node) + enddo +end subroutine finalize_field_list_nc + + +!> Open a MOM framework file +subroutine open_file_infra(handle, filename, action, MOM_domain, threading, fileset) + class(MOM_infra_file), intent(inout) :: handle + character(len=*), intent(in) :: filename + integer, intent(in), optional :: action + type(MOM_domain_type), optional, intent(in) :: MOM_domain + integer, intent(in), optional :: threading + integer, intent(in), optional :: fileset + + call open_file(handle%handle_infra, filename, action=action, & + MOM_domain=MOM_domain, threading=threading, fileset=fileset) + + call handle%axes%init() + call handle%fields%init() +end subroutine open_file_infra + +!> Close a MOM framework file +subroutine close_file_infra(handle) + class(MOM_infra_file), intent(inout) :: handle + + call close_file(handle%handle_infra) + call handle%axes%finalize() + call handle%fields%finalize() +end subroutine close_file_infra + +!> Flush the buffer of a MOM framework file +subroutine flush_file_infra(handle) + class(MOM_infra_file), intent(in) :: handle + + call flush_file(handle%handle_infra) +end subroutine flush_file_infra + + +!> Register an axis to the MOM framework file +function register_axis_infra(handle, label, units, longname, & + cartesian, sense, domain, data, edge_axis, calendar) result(axis) + + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: label + !< The name in the file of this axis + character(len=*), intent(in) :: units + !< The units of this axis + character(len=*), intent(in) :: longname + !< The long description of this axis + character(len=*), optional, intent(in) :: cartesian + !< A variable indicating which direction this axis corresponds with. + !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer, optional, intent(in) :: sense + !< This is 1 for axes whose values increase upward, or -1 if they increase + !! downward. + type(domain1D), optional, intent(in) :: domain + !< The domain decomposion for this axis + real, dimension(:), optional, intent(in) :: data + !< The coordinate values of the points on this axis + logical, optional, intent(in) :: edge_axis + !< If true, this axis marks an edge of the tracer cells + character(len=*), optional, intent(in) :: calendar + !< The name of the calendar used with a time axis + type(MOM_axis) :: axis + !< The axis type where this information is stored + + type(axistype) :: ax_infra + + ! Create new infra axis and assign to pre-allocated tail of axes + call write_metadata(handle%handle_infra, ax_infra, label, units, longname, & + cartesian=cartesian, sense=sense, domain=domain, data=data, & + edge_axis=edge_axis, calendar=calendar) + + call handle%axes%append(ax_infra, label) + axis%label = label +end function register_axis_infra + + +!> Register a field to the MOM framework file +function register_field_infra(handle, axes, label, units, longname, pack, & + standard_name, checksum) result(field) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), dimension(:), intent(in) :: axes + !< Handles for the axis used for this variable + character(len=*), intent(in) :: label + !< The name in the file of this variable + character(len=*), intent(in) :: units + !< The units of this variable + character(len=*), intent(in) :: longname + !< The long description of this variable + integer, optional, intent(in) :: pack + !< A precision reduction factor with which the variable. The default, 1, + !! has no reduction, but 2 is not uncommon. + character(len=*), optional, intent(in) :: standard_name + !< The standard (e.g., CMOR) name for this variable + integer(kind=int64), dimension(:), optional, intent(in) :: checksum + !< Checksum values that can be used to verify reads. + type(MOM_field) :: field + !< The field type where this information is stored + + type(fieldtype) :: field_infra + type(axistype), allocatable :: field_axes(:) + integer :: i + + ! Construct array of framework axes + allocate(field_axes(size(axes))) + do i = 1, size(axes) + field_axes(i) = handle%axes%get(axes(i)%label) + enddo + + call write_metadata(handle%handle_infra, field_infra, field_axes, label, & + units, longname, pack=pack, standard_name=standard_name, checksum=checksum) + + call handle%fields%append(field_infra, label) + field%label = label +end function register_field_infra + + +!> Write a 4D field to the MOM framework file +subroutine write_field_4d_infra(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, MOM_domain, field, & + tstamp=tstamp, tile_count=tile_count, fill_value=fill_value) +end subroutine write_field_4d_infra + + +!> Write a 3D field to the MOM framework file +subroutine write_field_3d_infra(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, MOM_domain, field, & + tstamp=tstamp, tile_count=tile_count, fill_value=fill_value) +end subroutine write_field_3d_infra + + +!> Write a 2D field to the MOM framework file +subroutine write_field_2d_infra(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, MOM_domain, field, & + tstamp=tstamp, tile_count=tile_count, fill_value=fill_value) +end subroutine write_field_2d_infra + + +!> Write a 1D field to the MOM framework file +subroutine write_field_1d_infra(handle, field_md, field, tstamp) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, dimension(:), intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, field, tstamp=tstamp) +end subroutine write_field_1d_infra + + +!> Write a 0D field to the MOM framework file +subroutine write_field_0d_infra(handle, field_md, field, tstamp) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field_md%label) + call write_field(handle%handle_infra, field_infra, field, tstamp=tstamp) +end subroutine write_field_0d_infra + + +!> Write an axis field to the MOM framework file +subroutine write_field_axis_infra(handle, axis) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axis + !< An axis type variable with information to write + + type(axistype) :: axis_infra + !< An axis type variable with information to write + + axis_infra = handle%axes%get(axis%label) + call write_field(handle%handle_infra, axis_infra) +end subroutine write_field_axis_infra + + +!> Write global metadata to the MOM framework file +subroutine write_attribute_infra(handle, name, attribute) + class(MOM_infra_file), intent(in) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: name + !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute + !< The value of this attribute + + call write_metadata(handle%handle_infra, name, attribute) +end subroutine write_attribute_infra + + +!> True if the framework file has been opened +logical function file_is_open_infra(handle) + class(MOM_infra_file), intent(in) :: handle + !< Handle to a file to inquire about + + file_is_open_infra = fms2_file_is_open(handle%handle_infra) +end function file_is_open_infra + + +!> Return number of dimensions, variables, or time levels in a MOM infra file +subroutine get_file_info_infra(handle, ndim, nvar, ntime) + class(MOM_infra_file), intent(in) :: handle + !< Handle for a file that is open for I/O + integer, optional, intent(out) :: ndim + !< The number of dimensions in the file + integer, optional, intent(out) :: nvar + !< The number of variables in the file + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + + call get_file_info(handle%handle_infra, ndim, nvar, ntime) +end subroutine get_file_info_infra + + +!> Return the field metadata associated with a MOM framework file +subroutine get_file_fields_infra(handle, fields) + class(MOM_infra_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), intent(inout) :: fields(:) + !< Field-type descriptions of all of the variables in a file. + + type(fieldtype), allocatable :: fields_infra(:) + integer :: i + character(len=64) :: label + + allocate(fields_infra(size(fields))) + call get_file_fields(handle%handle_infra, fields_infra) + + do i = 1, size(fields) + call get_field_atts(fields_infra(i), name=label) + call handle%fields%append(fields_infra(i), trim(label)) + fields(i)%label = trim(label) + enddo +end subroutine get_file_fields_infra + + +!> Get time levels of a MOM framework file +subroutine get_file_times_infra(handle, time_values, ntime) + class(MOM_infra_file), intent(in) :: handle + !< Handle for a file that is open for I/O + real, allocatable, dimension(:), intent(inout) :: time_values + !< The real times for the records in file. + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + + call get_file_times(handle%handle_infra, time_values, ntime=ntime) +end subroutine get_file_times_infra + + +!> Get attributes from a field +subroutine get_field_atts_infra(handle, field, name, units, longname, checksum) + class(MOM_infra_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field to extract information from + character(len=*), optional, intent(out) :: name + !< The variable name + character(len=*), optional, intent(out) :: units + !< The units of the variable + character(len=*), optional, intent(out) :: longname + !< The long name of the variable + integer(kind=int64), optional, intent(out) :: checksum(:) + !< The checksums of the variable in a file + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field%label) + call get_field_atts(field_infra, name, units, longname, checksum) +end subroutine get_field_atts_infra + + +!> Interface to read_field_chksum +subroutine read_field_chksum_infra(handle, field, chksum, valid_chksum) + class(MOM_infra_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field whose checksum attribute is to be read + integer(kind=int64), intent(out) :: chksum + !< The checksum for the field. + logical, intent(out) :: valid_chksum + !< If true, chksum has been successfully read + + type(fieldtype) :: field_infra + + field_infra = handle%fields%get(field%label) + call read_field_chksum(field_infra, chksum, valid_chksum) +end subroutine read_field_chksum_infra + +!> Get the native (fieldtype) fields of a MOM framework file +subroutine get_file_fieldtypes(handle, fields) + class(MOM_infra_file), intent(in) :: handle + type(fieldtype), intent(out) :: fields(:) + + type(field_node_infra), pointer :: node + integer :: i + + ! NOTE: The tail is a pre-allocated empty node, so we check node%next + node => handle%fields%head + do i = 1, size(fields) + if (.not. associated(node%next)) & + call MOM_error(FATAL, 'fields(:) size exceeds number of registered fields.') + fields(i) = node%field + node => node%next + enddo +end subroutine get_file_fieldtypes + + +! MOM_netcdf_file methods + +!> Open a MOM netCDF file +subroutine open_file_nc(handle, filename, action, MOM_domain, threading, fileset) + class(MOM_netcdf_file), intent(inout) :: handle + character(len=*), intent(in) :: filename + integer, intent(in), optional :: action + type(MOM_domain_type), optional, intent(in) :: MOM_domain + integer, intent(in), optional :: threading + integer, intent(in), optional :: fileset + + if (.not. present(MOM_domain) .and. .not. is_root_PE()) return + + call open_netcdf_file(handle%handle_nc, filename, action) + handle%is_open = .true. + + if (present(MOM_domain)) then + handle%domain_decomposed = .true. + call hor_index_init(MOM_domain, handle%HI) + endif + + call handle%axes%init() + call handle%fields%init() +end subroutine open_file_nc + + +!> Close a MOM netCDF file +subroutine close_file_nc(handle) + class(MOM_netcdf_file), intent(inout) :: handle + + if (.not. handle%domain_decomposed .and. .not. is_root_PE()) return + + handle%is_open = .false. + call close_netcdf_file(handle%handle_nc) +end subroutine close_file_nc + + +!> Flush the buffer of a MOM netCDF file +subroutine flush_file_nc(handle) + class(MOM_netcdf_file), intent(in) :: handle + + if (.not. is_root_PE()) return + + call flush_netcdf_file(handle%handle_nc) +end subroutine flush_file_nc + + +!> Register an axis to the MOM netcdf file +function register_axis_nc(handle, label, units, longname, cartesian, sense, & + domain, data, edge_axis, calendar) result(axis) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a netCDF file that is open for writing + character(len=*), intent(in) :: label + !< The name in the file of this axis + character(len=*), intent(in) :: units + !< The units of this axis + character(len=*), intent(in) :: longname + !< The long description of this axis + character(len=*), optional, intent(in) :: cartesian + !< A variable indicating which direction this axis corresponds with. + !! Valid values include 'X', 'Y', 'Z', 'T', and 'N' for none. + integer, optional, intent(in) :: sense + !< This is 1 for axes whose values increase upward, or -1 if they increase + !! downward. + type(domain1D), optional, intent(in) :: domain + !< The domain decomposion for this axis + real, dimension(:), optional, intent(in) :: data + !< The coordinate values of the points on this axis + logical, optional, intent(in) :: edge_axis + !< If true, this axis marks an edge of the tracer cells + character(len=*), optional, intent(in) :: calendar + !< The name of the calendar used with a time axis + type(MOM_axis) :: axis + + type(netcdf_axis) :: axis_nc + + if (is_root_PE()) then + axis_nc = register_netcdf_axis(handle%handle_nc, label, units, longname, & + data, cartesian, sense) + + call handle%axes%append(axis_nc, label) + endif + axis%label = label +end function register_axis_nc + + +!> Register a field to the MOM netcdf file +function register_field_nc(handle, axes, label, units, longname, pack, & + standard_name, checksum) result(field) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axes(:) + !< Handles for the axis used for this variable + character(len=*), intent(in) :: label + !< The name in the file of this variable + character(len=*), intent(in) :: units + !< The units of this variable + character(len=*), intent(in) :: longname + !< The long description of this variable + integer, optional, intent(in) :: pack + !< A precision reduction factor with which the variable. The default, 1, + !! has no reduction, but 2 is not uncommon. + character(len=*), optional, intent(in) :: standard_name + !< The standard (e.g., CMOR) name for this variable + integer(kind=int64), dimension(:), optional, intent(in) :: checksum + !< Checksum values that can be used to verify reads. + type(MOM_field) :: field + + type(netcdf_field) :: field_nc + type(netcdf_axis), allocatable :: axes_nc(:) + integer :: i + + if (is_root_PE()) then + allocate(axes_nc(size(axes))) + do i = 1, size(axes) + axes_nc(i) = handle%axes%get(axes(i)%label) + enddo + + field_nc = register_netcdf_field(handle%handle_nc, label, axes_nc, longname, units) + + call handle%fields%append(field_nc, label) + endif + field%label = label +end function register_field_nc + + +!> Write global metadata to the MOM netcdf file +subroutine write_attribute_nc(handle, name, attribute) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle for a file that is open for writing + character(len=*), intent(in) :: name + !< The name in the file of this global attribute + character(len=*), intent(in) :: attribute + !< The value of this attribute + + if (.not. is_root_PE()) return + + call write_netcdf_attribute(handle%handle_nc, name, attribute) +end subroutine write_attribute_nc + + +!> Write a 4D field to the MOM netcdf file +subroutine write_field_4d_nc(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_4d_nc + + +!> Write a 3D field to the MOM netcdf file +subroutine write_field_3d_nc(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, intent(inout) :: field(:,:,:) + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_3d_nc + + +!> Write a 2D field to the MOM netcdf file +subroutine write_field_2d_nc(handle, field_md, MOM_domain, field, tstamp, & + tile_count, fill_value) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + type(MOM_domain_type), intent(in) :: MOM_domain + !< The MOM_Domain that describes the decomposition + real, dimension(:,:), intent(inout) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + integer, optional, intent(in) :: tile_count + !< PEs per tile (default: 1) + real, optional, intent(in) :: fill_value + !< Missing data fill value + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_2d_nc + + +!> Write a 1D field to the MOM netcdf file +subroutine write_field_1d_nc(handle, field_md, field, tstamp) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, dimension(:), intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_1d_nc + + +!> Write a 0D field to the MOM netcdf file +subroutine write_field_0d_nc(handle, field_md, field, tstamp) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_field), intent(in) :: field_md + !< Field type with metadata + real, intent(in) :: field + !< Field to write + real, optional, intent(in) :: tstamp + !< Model time of this field + + type(netcdf_field) :: field_nc + + if (.not. is_root_PE()) return + + field_nc = handle%fields%get(field_md%label) + call write_netcdf_field(handle%handle_nc, field_nc, field, time=tstamp) +end subroutine write_field_0d_nc + + +!> Write an axis field to the MOM netcdf file +subroutine write_field_axis_nc(handle, axis) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for writing + type(MOM_axis), intent(in) :: axis + !< An axis type variable with information to write + + type(netcdf_axis) :: axis_nc + + if (.not. is_root_PE()) return + + axis_nc = handle%axes%get(axis%label) + call write_netcdf_axis(handle%handle_nc, axis_nc) +end subroutine write_field_axis_nc + + +!> True if the framework file has been opened +logical function file_is_open_nc(handle) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle to a file to inquire about + + file_is_open_nc = handle%is_open +end function file_is_open_nc + + +!> Return number of dimensions, variables, or time levels in a MOM netcdf file +subroutine get_file_info_nc(handle, ndim, nvar, ntime) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle for a file that is open for I/O + integer, optional, intent(out) :: ndim + !< The number of dimensions in the file + integer, optional, intent(out) :: nvar + !< The number of variables in the file + integer, optional, intent(out) :: ntime + !< The number of time levels in the file + + integer :: ndim_nc, nvar_nc + + if (.not. is_root_PE()) return + + call get_netcdf_size(handle%handle_nc, ndims=ndim_nc, nvars=nvar_nc, nsteps=ntime) + + ! MOM I/O follows legacy FMS behavior and excludes axes from field count + if (present(ndim)) ndim = ndim_nc + if (present(nvar)) nvar = nvar_nc - ndim_nc +end subroutine get_file_info_nc + + +!> Update the axes and fields descriptors of a MOM netCDF file +subroutine update_file_contents_nc(handle) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + + type(netcdf_axis), allocatable :: axes_nc(:) + ! netCDF axis descriptors + type(netcdf_field), allocatable :: fields_nc(:) + ! netCDF field descriptors + integer :: i + ! Index counter + + if (.not. handle%domain_decomposed .and. .not. is_root_PE()) return + + call get_netcdf_fields(handle%handle_nc, axes_nc, fields_nc) + + do i = 1, size(axes_nc) + call handle%axes%append(axes_nc(i), axes_nc(i)%label) + enddo + + do i = 1, size(fields_nc) + call handle%fields%append(fields_nc(i), fields_nc(i)%label) + enddo +end subroutine update_file_contents_nc + + +!> Return the field descriptors of a MOM netCDF file +subroutine get_file_fields_nc(handle, fields) + class(MOM_netcdf_file), intent(inout) :: handle + !< Handle for a file that is open for I/O + type(MOM_field), intent(inout) :: fields(:) + !< Field-type descriptions of all of the variables in a file. + + type(field_node_nc), pointer :: node => null() + ! Current field list node + integer :: n + ! Field counter + + if (.not. is_root_PE()) return + + ! Generate the manifest of axes and fields + call handle%update() + + n = 0 + node => handle%fields%head + do while (associated(node%next)) + n = n + 1 + fields(n)%label = trim(node%label) + node => node%next + enddo +end subroutine get_file_fields_nc + + +!> Get attributes from a netCDF field +subroutine get_field_atts_nc(handle, field, name, units, longname, checksum) + class(MOM_netcdf_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field to extract information from + character(len=*), optional, intent(out) :: name + !< The variable name + character(len=*), optional, intent(out) :: units + !< The units of the variable + character(len=*), optional, intent(out) :: longname + !< The long name of the variable + integer(kind=int64), optional, intent(out) :: checksum(:) + !< The checksums of the variable in a file + + call MOM_error(FATAL, 'get_field_atts over netCDF is not yet implemented.') +end subroutine get_field_atts_nc + + +!> Interface to read_field_chksum +subroutine read_field_chksum_nc(handle, field, chksum, valid_chksum) + class(MOM_netcdf_file), intent(in) :: handle + !< File where field is stored + type(MOM_field), intent(in) :: field + !< The field whose checksum attribute is to be read + integer(kind=int64), intent(out) :: chksum + !< The checksum for the field. + logical, intent(out) :: valid_chksum + !< If true, chksum has been successfully read + + call MOM_error(FATAL, 'read_field_chksum over netCDF is not yet implemented.') +end subroutine read_field_chksum_nc + + +!> Read the values of a netCDF field into an array that might have halos +subroutine get_field_nc(handle, label, values, rescale) + class(MOM_netcdf_file), intent(in) :: handle + !< Handle of netCDF file to be read + character(len=*), intent(in) :: label + !< Field variable name + real, intent(inout) :: values(:,:) + !< Field values read from the file. It would be intent(out) but for the + !! need to preserve any initialized values in the halo regions. + real, optional, intent(in) :: rescale + !< A multiplicative rescaling factor for the values that are read. + !! Omitting this is the same as setting it to 1. + + logical :: data_domain + ! True if values matches the data domain size + logical :: compute_domain + ! True if values matches the compute domain size + type(netcdf_field) :: field_nc + ! netCDF field associated with label + integer :: isc, iec, jsc, jec + ! Index bounds of compute domain + integer :: isd, ied, jsd, jed + ! Index bounds of data domain + integer :: iscl, iecl, jscl, jecl + ! Local 1-based index bounds of compute domain + integer :: bounds(2,2) + ! Index bounds of domain + real, allocatable :: values_c(:,:) + ! Field values on the compute domain, used for copying to a data domain + + isc = handle%HI%isc + iec = handle%HI%iec + jsc = handle%HI%jsc + jec = handle%HI%jec + + isd = handle%HI%isd + ied = handle%HI%ied + jsd = handle%HI%jsd + jed = handle%HI%jed + + data_domain = all(shape(values) == [ied-isd+1, jed-jsd+1]) + compute_domain = all(shape(values) == [iec-isc+1, jec-jsc+1]) + + ! NOTE: Data on face and vertex points is not yet supported. This is a + ! temporary check to detect such cases, but may be removed in the future. + if (.not. (compute_domain .or. data_domain)) & + call MOM_error(FATAL, 'get_field_nc: Only compute and data domains ' // & + 'are currently supported.') + + field_nc = handle%fields%get(label) + + if (data_domain) & + allocate(values_c(1:iec-isc+1,1:jec-jsc+1)) + + if (handle%domain_decomposed) then + bounds(1,:) = [isc, jsc] + [handle%HI%idg_offset, handle%HI%jdg_offset] + bounds(2,:) = [iec, jec] + [handle%HI%idg_offset, handle%HI%jdg_offset] + if (data_domain) then + call read_netcdf_field(handle%handle_nc, field_nc, values_c, bounds=bounds) + else + call read_netcdf_field(handle%handle_nc, field_nc, values, bounds=bounds) + endif + else + if (data_domain) then + call read_netcdf_field(handle%handle_nc, field_nc, values_c) + else + call read_netcdf_field(handle%handle_nc, field_nc, values) + endif + endif + + if (data_domain) then + iscl = isc - isd + 1 + iecl = iec - isd + 1 + jscl = jsc - jsd + 1 + jecl = jec - jsd + 1 + + values(iscl:iecl,jscl:jecl) = values_c(:,:) + else + iscl = 1 + iecl = iec - isc + 1 + jscl = 1 + jecl = jec - jsc + 1 + endif + + ! NOTE: It is more efficient to do the rescale in-place while copying + ! values_c(:,:) to values(:,:). But since rescale is only present for + ! debugging, we can probably disregard this impact on performance. + if (present(rescale)) then + if (rescale /= 1.0) then + values(iscl:iecl,jscl:jecl) = rescale * values(iscl:iecl,jscl:jecl) + endif + endif +end subroutine get_field_nc + + +!> \namespace MOM_IO_file +!! +!! This file defines the MOM_file classes used to inferface with the internal +!! IO handlers, such as the configured "infra" layer (FMS) or native netCDF. +!! +!! `MOM_file`: The generic class used to reference any file type +!! Cannot be used in a variable declaration. +!! +!! `MOM_infra_file`: A file handler for use by the infra layer. Currently this +!! means an FMS file, such a restart or diagnostic output. +!! +!! `MOM_netcdf_file`: A netCDF file handler for MOM-specific I/O. This may +!! include operations outside the scope of FMS or other infra frameworks. + +end module MOM_io_file diff --git a/src/framework/MOM_netcdf.F90 b/src/framework/MOM_netcdf.F90 new file mode 100644 index 0000000000..95e6aa7bb7 --- /dev/null +++ b/src/framework/MOM_netcdf.F90 @@ -0,0 +1,796 @@ +!> MOM6 interface to netCDF operations +module MOM_netcdf + +! This file is part of MOM6. See LICENSE.md for the license. + +use, intrinsic :: iso_fortran_env, only : real32, real64 + +use netcdf, only : nf90_create, nf90_open, nf90_close +use netcdf, only : nf90_sync +use netcdf, only : NF90_CLOBBER, NF90_NOCLOBBER, NF90_WRITE, NF90_NOWRITE +use netcdf, only : nf90_enddef +use netcdf, only : nf90_def_dim, nf90_def_var +use netcdf, only : NF90_UNLIMITED +use netcdf, only : nf90_get_var +use netcdf, only : nf90_put_var, nf90_put_att +use netcdf, only : NF90_FLOAT, NF90_DOUBLE +use netcdf, only : nf90_strerror, NF90_NOERR +use netcdf, only : NF90_GLOBAL +use netcdf, only : nf90_inquire, nf90_inquire_dimension, nf90_inquire_variable +use netcdf, only : nf90_inq_dimids, nf90_inq_varids +use netcdf, only : NF90_MAX_NAME + +use MOM_error_handler, only : MOM_error, FATAL +use MOM_io_infra, only : READONLY_FILE, WRITEONLY_FILE +use MOM_io_infra, only : APPEND_FILE, OVERWRITE_FILE + +implicit none ; private + +public :: netcdf_file_type +public :: netcdf_axis +public :: netcdf_field +public :: open_netcdf_file +public :: close_netcdf_file +public :: flush_netcdf_file +public :: register_netcdf_axis +public :: register_netcdf_field +public :: write_netcdf_field +public :: write_netcdf_axis +public :: write_netcdf_attribute +public :: get_netcdf_size +public :: get_netcdf_fields +public :: read_netcdf_field + + +!> Internal time value used to indicate an uninitialized time +real, parameter :: NULLTIME = -1 +! NOTE: For now, we use the FMS-compatible value, but may change in the future. + + +!> netCDF file abstraction +type :: netcdf_file_type + private + integer :: ncid + !< netCDF file ID + character(len=:), allocatable :: filename + !< netCDF filename + logical :: define_mode + !< True if file is in define mode. + integer :: time_id + !< Time axis variable ID + real :: time + !< Current model time + integer :: time_level + !< Current time level for output +end type netcdf_file_type + + +!> Dimension axis for a netCDF file +type :: netcdf_axis + private + character(len=:), allocatable, public :: label + !< Axis label name + real, allocatable :: points(:) + !< Grid points along the axis + integer :: dimid + !< netCDF dimension ID associated with axis + integer :: varid + !< netCDF variable ID associated with axis +end type netcdf_axis + + +!> Field variable for a netCDF file +type netcdf_field + private + character(len=:), allocatable, public :: label + !< Variable name + integer :: varid + !< netCDF variable ID for field +end type netcdf_field + + +!> Write values to a field of a netCDF file +interface write_netcdf_field + module procedure write_netcdf_field_4d + module procedure write_netcdf_field_3d + module procedure write_netcdf_field_2d + module procedure write_netcdf_field_1d + module procedure write_netcdf_field_0d +end interface write_netcdf_field + +contains + +subroutine open_netcdf_file(handle, filename, mode) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + character(len=*), intent(in) :: filename + !< netCDF filename + integer, intent(in), optional :: mode + !< Input MOM I/O mode + + integer :: io_mode + ! MOM I/O mode + integer :: cmode + ! netCDF creation mode + integer :: rc + ! nf90_create return code + character(len=:), allocatable :: msg + ! netCDF error message buffer + + ! I/O configuration + io_mode = WRITEONLY_FILE + if (present(mode)) io_mode = mode + + ! Translate the MOM I/O config to the netCDF mode + select case(io_mode) + case (WRITEONLY_FILE) + rc = nf90_create(filename, nf90_noclobber, handle%ncid) + handle%define_mode = .true. + case (OVERWRITE_FILE) + rc = nf90_create(filename, nf90_clobber, handle%ncid) + handle%define_mode = .true. + case (APPEND_FILE) + rc = nf90_open(filename, nf90_write, handle%ncid) + handle%define_mode = .false. + case (READONLY_FILE) + rc = nf90_open(filename, nf90_nowrite, handle%ncid) + handle%define_mode = .false. + case default + call MOM_error(FATAL, & + 'open_netcdf_file: File ' // filename // ': Unknown mode.') + end select + call check_netcdf_call(rc, 'open_netcdf_file', 'File ' // filename) + + handle%filename = filename + + ! FMS writes the filename as an attribute + if (any(io_mode == [WRITEONLY_FILE, OVERWRITE_FILE])) & + call write_netcdf_attribute(handle, 'filename', filename) +end subroutine open_netcdf_file + + +!> Close an opened netCDF file. +subroutine close_netcdf_file(handle) + type(netcdf_file_type), intent(in) :: handle + + integer :: rc + + rc = nf90_close(handle%ncid) + call check_netcdf_call(rc, 'close_netcdf_file', & + 'File "' // handle%filename // '"') +end subroutine close_netcdf_file + + +!> Flush buffered output to the netCDF file +subroutine flush_netcdf_file(handle) + type(netcdf_file_type), intent(in) :: handle + + integer :: rc + + rc = nf90_sync(handle%ncid) + call check_netcdf_call(rc, 'flush_netcdf_file', & + 'File "' // handle%filename // '"') +end subroutine flush_netcdf_file + + +!> Change netCDF mode of handle from 'define' to 'write'. +subroutine enable_netcdf_write(handle) + type(netcdf_file_type), intent(inout) :: handle + + integer :: rc + + if (handle%define_mode) then + rc = nf90_enddef(handle%ncid) + call check_netcdf_call(rc, 'enable_netcdf_write', & + 'File "' // handle%filename // '"') + handle%define_mode = .false. + endif +end subroutine enable_netcdf_write + + +!> Register a netCDF variable +function register_netcdf_field(handle, label, axes, longname, units) & + result(field) + type(netcdf_file_type), intent(in) :: handle + !< netCDF file handle + character(len=*), intent(in) :: label + !< netCDF field name in the file + type(netcdf_axis), intent(in) :: axes(:) + !< Axes along which field is defined + character(len=*), intent(in) :: longname + !< Long name of the netCDF field + character(len=*), intent(in) :: units + !< Field units of measurement + type(netcdf_field) :: field + !< netCDF field + + integer :: rc + ! netCDF function return code + integer :: i + ! Loop index + integer, allocatable :: dimids(:) + ! netCDF dimension IDs of axes + integer :: xtype + ! netCDF data type + + ! Gather the axis netCDF dimension IDs + allocate(dimids(size(axes))) + dimids(:) = [(axes(i)%dimid, i = 1, size(axes))] + + ! Determine the corresponding netCDF data type + ! TODO: Support a `pack`-like argument + select case (kind(1.0)) + case (real32) + xtype = NF90_FLOAT + case (real64) + xtype = NF90_DOUBLE + case default + call MOM_error(FATAL, "register_netcdf_axis: Unknown kind(real).") + end select + + ! Register the field variable + rc = nf90_def_var(handle%ncid, label, xtype, dimids, field%varid) + call check_netcdf_call(rc, 'register_netcdf_field', & + 'File "' // handle%filename // '", Field "' // label // '"') + + ! Assign attributes + + rc = nf90_put_att(handle%ncid, field%varid, 'long_name', longname) + call check_netcdf_call(rc, 'register_netcdf_field', & + 'Attribute "long_name" of variable "' // label // '" in file "' & + // handle%filename // '"') + + rc = nf90_put_att(handle%ncid, field%varid, 'units', units) + call check_netcdf_call(rc, 'register_netcdf_field', & + 'Attribute "units" of variable "' // label // '" in file "' & + // handle%filename // '"') +end function register_netcdf_field + + +!> Create an axis and associated dimension in a netCDF file +function register_netcdf_axis(handle, label, units, longname, points, & + cartesian, sense) result(axis) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + character(len=*), intent(in) :: label + !< netCDF axis name in the file + character(len=*), intent(in), optional :: units + !< Axis units of measurement + character(len=*), intent(in), optional :: longname + !< Long name of the axis + real, intent(in), optional :: points(:) + !< Values of axis points (for fixed axes) + character(len=*), intent(in), optional :: cartesian + !< Character denoting axis direction: X, Y, Z, T, or N for none + integer, intent(in), optional :: sense + !< Axis direction; +1 if axis increases upward or -1 if downward + + type(netcdf_axis) :: axis + !< netCDF coordinate axis + + integer :: xtype + ! netCDF external data type + integer :: rc + ! netCDF function return code + logical :: unlimited + ! True if the axis is unlimited in size (e.g. time) + integer :: axis_size + ! Either the number of points in the axis, or unlimited flag + integer :: axis_sense + ! Axis direction; +1 if axis increases upward or -1 if downward + character(len=:), allocatable :: sense_attr + ! CF-compiant value of sense attribute (as 'positive') + + ! Create the axis dimension + unlimited = .false. + if (present(cartesian)) then + if (cartesian == 'T') unlimited = .true. + endif + + ! Either the axis is explicitly set with data or is declared as unlimited + if (present(points) .eqv. unlimited) then + call MOM_error(FATAL, & + "Axis must either have explicit points or be a time axis ('T').") + endif + + if (present(points)) then + axis_size = size(points) + allocate(axis%points(axis_size)) + axis%points(:) = points(:) + else + axis_size = NF90_UNLIMITED + endif + + rc = nf90_def_dim(handle%ncid, label, axis_size, axis%dimid) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Dimension "' // label // '" in file "' // handle%filename // '"') + + ! Determine the corresponding netCDF data type + ! TODO: Support a `pack`-like argument + select case (kind(1.0)) + case (real32) + xtype = NF90_FLOAT + case (real64) + xtype = NF90_DOUBLE + case default + call MOM_error(FATAL, "register_netcdf_axis: Unknown kind(real).") + end select + + ! Create a variable corresponding to the axis + rc = nf90_def_var(handle%ncid, label, xtype, axis%dimid, axis%varid) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Variable ' // label // ' in file ' // handle%filename) + + ! Define the time axis, if available + if (unlimited) then + handle%time_id = axis%varid + handle%time_level = 0 + handle%time = NULLTIME + endif + + ! Assign attributes if present + if (present(longname)) then + rc = nf90_put_att(handle%ncid, axis%varid, 'long_name', longname) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute ''long_name'' of variable ' // label // ' in file ' & + // handle%filename) + endif + + if (present(units)) then + rc = nf90_put_att(handle%ncid, axis%varid, 'units', units) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute ''units'' of variable ' // label // ' in file ' & + // handle%filename) + endif + + if (present(cartesian)) then + rc = nf90_put_att(handle%ncid, axis%varid, 'cartesian_axis', cartesian) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute ''cartesian_axis'' of variable ' // label // ' in file ' & + // handle%filename) + endif + + axis_sense = 0 + if (present(sense)) axis_sense = sense + + if (axis_sense /= 0) then + select case (axis_sense) + case (1) + sense_attr = 'up' + case (-1) + sense_attr = 'down' + case default + call MOM_error(FATAL, 'register_netcdf_axis: sense must be either ' & + // '0, 1, or -1.') + end select + rc = nf90_put_att(handle%ncid, axis%varid, 'positive', sense_attr) + call check_netcdf_call(rc, 'register_netcdf_axis', & + 'Attribute "positive" of variable "' // label // '" in file "' & + // handle%filename // '"') + endif +end function register_netcdf_axis + + +!> Write a 4D array to a compatible netCDF field +subroutine write_netcdf_field_4d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:,:,:,:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(5) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(:4) = 1 + start(5) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_4d + + +!> Write a 3D array to a compatible netCDF field +subroutine write_netcdf_field_3d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:,:,:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(4) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(:3) = 1 + start(4) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_3d + + +!> Write a 2D array to a compatible netCDF field +subroutine write_netcdf_field_2d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:,:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(3) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(:2) = 1 + start(3) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_2d + + +!> Write a 1D array to a compatible netCDF field +subroutine write_netcdf_field_1d(handle, field, values, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: values(:) + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(2) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(1) = 1 + start(2) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, values, start) + else + rc = nf90_put_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_1d + + +!> Write a scalar to a compatible netCDF field +subroutine write_netcdf_field_0d(handle, field, scalar, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_field), intent(in) :: field + !< Field metadata + real, intent(in) :: scalar + !< Field values + real, intent(in), optional :: time + !< Timestep index to write data + + integer :: rc + ! netCDF return code + integer :: start(1) + ! Start indices, if timestep is included + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + if (present(time)) then + call update_netcdf_timestep(handle, time) + start(1) = handle%time_level + rc = nf90_put_var(handle%ncid, field%varid, scalar, start) + else + rc = nf90_put_var(handle%ncid, field%varid, scalar) + endif + call check_netcdf_call(rc, 'write_netcdf_file', & + 'File "' // handle%filename // '", Field "' // field%label // '"') +end subroutine write_netcdf_field_0d + + +!> Write axis points to associated netCDF variable +subroutine write_netcdf_axis(handle, axis) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_axis), intent(in) :: axis + !< field variable + + integer :: rc + ! netCDF return code + + ! Verify write mode + if (handle%define_mode) & + call enable_netcdf_write(handle) + + rc = nf90_put_var(handle%ncid, axis%varid, axis%points) + call check_netcdf_call(rc, 'write_netcdf_axis', & + 'File "' // handle%filename // '", Axis "' // axis%label // '"') +end subroutine write_netcdf_axis + + +!> Write a global attribute to a netCDF file +subroutine write_netcdf_attribute(handle, label, attribute) + type(netcdf_file_type), intent(in) :: handle + !< netCDF file handle + character(len=*), intent(in) :: label + !< File attribute + character(len=*), intent(in) :: attribute + !< File attribute value + + integer :: rc + ! netCDF return code + + rc = nf90_put_att(handle%ncid, NF90_GLOBAL, label, attribute) + call check_netcdf_call(rc, 'write_netcdf_attribute', & + 'File "' // handle%filename // '", Attribute "' // label // '"') +end subroutine write_netcdf_attribute + + +! This is a thin interface to nf90_inquire, designed to mirror the existing +! I/O API. A more axis-aware system might not need this, but for now it's here +!> Get the number of dimensions, variables, and timesteps in a netCDF file +subroutine get_netcdf_size(handle, ndims, nvars, nsteps) + type(netcdf_file_type), intent(in) :: handle + !< netCDF input file + integer, intent(out), optional :: ndims + !< number of dimensions in the file + integer, intent(out), optional :: nvars + !< number of variables in the file + integer, intent(out), optional :: nsteps + !< number of values in the file's unlimited axis + + integer :: rc + ! netCDF return code + integer :: unlimited_dimid + ! netCDF dimension ID for unlimited time axis + + rc = nf90_inquire(handle%ncid, & + nDimensions=ndims, & + nVariables=nvars, & + unlimitedDimId=unlimited_dimid & + ) + call check_netcdf_call(rc, 'get_netcdf_size', & + 'File "' // handle%filename // '"') + + rc = nf90_inquire_dimension(handle%ncid, unlimited_dimid, len=nsteps) + call check_netcdf_call(rc, 'get_netcdf_size', & + 'File "' // handle%filename // '"') +end subroutine get_netcdf_size + + +!> Get the metadata of the registered fields in a netCDF file +subroutine get_netcdf_fields(handle, axes, fields) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + type(netcdf_axis), intent(inout), allocatable :: axes(:) + !< netCDF file axes + type(netcdf_field), intent(inout), allocatable :: fields(:) + !< netCDF file fields + + integer :: ndims + ! Number of netCDF dimensions + integer :: nvars + ! Number of netCDF dimensions + type(netcdf_field), allocatable :: vars(:) + ! netCDF variables in handle + integer :: nfields + ! Number of fields in the file (i.e. non-axis variables) + integer, allocatable :: dimids(:) + ! netCDF dimension IDs of file + integer, allocatable :: varids(:) + ! netCDF variable IDs of file + integer :: unlim_dimid + ! netCDF dimension ID for the unlimited axis variable, if present + integer :: unlim_index + ! Index of the unlimited axis in axes(:), if present + character(len=NF90_MAX_NAME) :: label + ! Current dimension or variable label + integer :: len + ! Current dimension length + integer :: rc + ! netCDF return code + integer :: grp_ndims, grp_nvars + ! Group-based counts for nf90_inq_* (unused) + logical :: is_axis + ! True if the current variable is an axis + integer :: i, j, n + + integer, save :: no_parent_groups = 0 + ! Flag indicating exclusion of parent groups in netCDF file + ! NOTE: This must be passed as a variable, and cannot be declared as a + ! parameter. + + rc = nf90_inquire(handle%ncid, & + nDimensions=ndims, & + nVariables=nvars, & + unlimitedDimId=unlim_dimid & + ) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + allocate(dimids(ndims)) + rc = nf90_inq_dimids(handle%ncid, grp_ndims, dimids, no_parent_groups) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // handle%filename // '"') + + allocate(varids(nvars)) + rc = nf90_inq_varids(handle%ncid, grp_nvars, varids) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // trim(handle%filename) // '"') + + ! Initialize unlim_index with an unreachable value (outside [1,ndims]) + unlim_index = -1 + + allocate(axes(ndims)) + do i = 1, ndims + rc = nf90_inquire_dimension(handle%ncid, dimids(i), name=label, len=len) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // trim(handle%filename) // '"') + + ! Check for the unlimited axis + if (dimids(i) == unlim_dimid) unlim_index = i + + axes(i)%dimid = dimids(i) + axes(i)%label = trim(label) + allocate(axes(i)%points(len)) + enddo + + ! We cannot know if every axis also has a variable representation, so we + ! over-allocate vars(:) and fill as fields are identified. + allocate(vars(nvars)) + + nfields = 0 + do i = 1, nvars + rc = nf90_inquire_variable(handle%ncid, varids(i), name=label) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // trim(handle%filename) // '"') + + ! Check if variable is an axis + is_axis = .false. + do j = 1, ndims + if (label == axes(j)%label) then + rc = nf90_get_var(handle%ncid, varids(i), axes(j)%points) + call check_netcdf_call(rc, 'get_netcdf_fields', & + 'File "' // trim(handle%filename) // '"') + axes(j)%varid = varids(i) + + if (j == unlim_index) then + handle%time_id = varids(i) + handle%time_level = size(axes(j)%points) + handle%time = NULLTIME + endif + + is_axis = .true. + exit + endif + enddo + if (is_axis) cycle + + nfields = nfields + 1 + vars(nfields)%label = trim(label) + vars(nfields)%varid = varids(i) + enddo + + allocate(fields(nfields)) + fields(:) = vars(:nfields) +end subroutine get_netcdf_fields + + +!> Read the values of a field from a netCDF file +subroutine read_netcdf_field(handle, field, values, bounds) + type(netcdf_file_type), intent(in) :: handle + type(netcdf_field), intent(in) :: field + real, intent(out) :: values(:,:) + integer, optional, intent(in) :: bounds(2,2) + + integer :: rc + ! netCDF return code + integer :: istart(2) + ! Axis start index + integer :: icount(2) + ! Axis index count + + if (present(bounds)) then + istart(:) = bounds(1,:) + icount(:) = bounds(2,:) - bounds(1,:) + 1 + rc = nf90_get_var(handle%ncid, field%varid, values, start=istart, count=icount) + else + rc = nf90_get_var(handle%ncid, field%varid, values) + endif + call check_netcdf_call(rc, 'read_netcdf_field', & + 'File "' // trim(handle%filename) // '", Field "' // trim(field%label) // '"') +end subroutine read_netcdf_field + + +!> Set the current timestep of an open netCDF file +subroutine update_netcdf_timestep(handle, time) + type(netcdf_file_type), intent(inout) :: handle + !< netCDF file handle + real, intent(in) :: time + !< New model time + + integer :: start(1) + !< Time axis start index array + integer :: rc + !< netCDF return code + + if (time > handle%time + epsilon(time)) then + handle%time = time + handle%time_level = handle%time_level + 1 + + ! Write new value to time axis + start = [handle%time_level] + rc = nf90_put_var(handle%ncid, handle%time_id, time, start=start) + call check_netcdf_call(rc, 'update_netcdf_timestep', & + 'File "' // handle%filename // '"') + endif +end subroutine update_netcdf_timestep + + +!> Check netCDF function return codes, report the error log, and abort the run. +subroutine check_netcdf_call(ncerr, header, message) + integer, intent(in) :: ncerr + !< netCDF error code + character(len=*), intent(in) :: header + !< Message header (usually calling subroutine) + character(len=*), intent(in) :: message + !< Error message (usually action which instigated the error) + + character(len=:), allocatable :: errmsg + ! Full error message, including netCDF message + + if (ncerr /= nf90_noerr) then + errmsg = trim(header) // ": " // trim(message) // new_line('/') & + // trim(nf90_strerror(ncerr)) + call MOM_error(FATAL, errmsg) + endif +end subroutine check_netcdf_call + +end module MOM_netcdf diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index a76e96499f..24ba0fa76b 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -8,9 +8,9 @@ module MOM_restart use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_io, only : create_file, file_type, fieldtype, file_exists, open_file, close_file -use MOM_io, only : MOM_read_data, read_data, MOM_write_field, read_field_chksum, field_exists -use MOM_io, only : get_file_info, get_file_fields, get_field_atts, get_file_times +use MOM_io, only : create_MOM_file, file_exists +use MOM_io, only : MOM_infra_file, MOM_field +use MOM_io, only : MOM_read_data, read_data, MOM_write_field, field_exists use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix use MOM_io, only : MULTIPLE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE @@ -27,29 +27,36 @@ module MOM_restart public restart_files_exist, determine_is_new_run, is_new_run public register_restart_field_as_obsolete, register_restart_pair +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. +! The functions in this module work with variables with arbitrary units, in which case the +! arbitrary rescaled units are indicated with [A ~> a], while the unscaled units are just [a]. + !> A type for making arrays of pointers to 4-d arrays type p4d - real, dimension(:,:,:,:), pointer :: p => NULL() !< A pointer to a 4d array + real, dimension(:,:,:,:), pointer :: p => NULL() !< A pointer to a 4d array in arbitrary rescaled units [A ~> a] end type p4d !> A type for making arrays of pointers to 3-d arrays type p3d - real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3d array + real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3d array in arbitrary rescaled units [A ~> a] end type p3d !> A type for making arrays of pointers to 2-d arrays type p2d - real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2d array + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2d array in arbitrary rescaled units [A ~> a] end type p2d !> A type for making arrays of pointers to 1-d arrays type p1d - real, dimension(:), pointer :: p => NULL() !< A pointer to a 1d array + real, dimension(:), pointer :: p => NULL() !< A pointer to a 1d array in arbitrary rescaled units [A ~> a] end type p1d !> A type for making arrays of pointers to scalars type p0d - real, pointer :: p => NULL() !< A pointer to a scalar + real, pointer :: p => NULL() !< A pointer to a scalar in arbitrary rescaled units [A ~> a] end type p0d !> A structure with information about a single restart field @@ -62,8 +69,8 @@ module MOM_restart character(len=32) :: var_name !< A name by which a variable may be queried. real :: conv = 1.0 !< A factor by which a restart field should be multiplied before it !! is written to a restart file, usually to convert it to MKS or - !! other standard units. When read, the restart field is multiplied - !! by the Adcroft reciprocal of this factor. + !! other standard units [a A-1 ~> 1]. When read, the restart field + !! is multiplied by the Adcroft reciprocal of this factor. end type field_restart !> A structure to store information about restart fields that are no longer used @@ -171,12 +178,13 @@ end subroutine register_restart_field_as_obsolete subroutine register_restart_field_ptr3d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -208,12 +216,13 @@ end subroutine register_restart_field_ptr3d subroutine register_restart_field_ptr4d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -245,12 +254,13 @@ end subroutine register_restart_field_ptr4d subroutine register_restart_field_ptr2d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -281,12 +291,13 @@ end subroutine register_restart_field_ptr2d !> Register a 1-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr1d(f_ptr, var_desc, mandatory, CS, conversion) real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -317,12 +328,13 @@ end subroutine register_restart_field_ptr1d !> Register a 0-d field for restarts, providing the metadata in a structure subroutine register_restart_field_ptr0d(f_ptr, var_desc, mandatory, CS, conversion) real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: var_desc !< A structure with metadata about this variable logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. if (.not.CS%initialized) call MOM_error(FATAL, "MOM_restart " // & "register_restart_field: Module must be initialized before it is used.") @@ -355,13 +367,15 @@ end subroutine register_restart_field_ptr0d subroutine register_restart_pair_ptr2d(a_ptr, b_ptr, a_desc, b_desc, & mandatory, CS, conversion) real, dimension(:,:), target, intent(in) :: a_ptr !< First field pointer + !! in arbitrary rescaled units [A ~> a] real, dimension(:,:), target, intent(in) :: b_ptr !< Second field pointer + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. call lock_check(CS, a_desc) @@ -378,14 +392,16 @@ end subroutine register_restart_pair_ptr2d !> Register a pair of rotationally equivalent 3d restart fields subroutine register_restart_pair_ptr3d(a_ptr, b_ptr, a_desc, b_desc, & mandatory, CS, conversion) - real, dimension(:,:,:), target, intent(in) :: a_ptr !< First field pointer - real, dimension(:,:,:), target, intent(in) :: b_ptr !< Second field pointer + real, dimension(:,:,:), target, intent(in) :: a_ptr !< First field pointer + !! in arbitrary rescaled units [A ~> a] + real, dimension(:,:,:), target, intent(in) :: b_ptr !< Second field pointer + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. call lock_check(CS, a_desc) @@ -403,13 +419,15 @@ end subroutine register_restart_pair_ptr3d subroutine register_restart_pair_ptr4d(a_ptr, b_ptr, a_desc, b_desc, & mandatory, CS, conversion) real, dimension(:,:,:,:), target, intent(in) :: a_ptr !< First field pointer + !! in arbitrary rescaled units [A ~> a] real, dimension(:,:,:,:), target, intent(in) :: b_ptr !< Second field pointer + !! in arbitrary rescaled units [A ~> a] type(vardesc), intent(in) :: a_desc !< First field descriptor type(vardesc), intent(in) :: b_desc !< Second field descriptor logical, intent(in) :: mandatory !< If true, abort if field is missing type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control structure real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. call lock_check(CS, a_desc) @@ -430,6 +448,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units hor_grid, z_grid, t_grid) real, dimension(:,:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -437,7 +456,7 @@ subroutine register_restart_field_4d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -462,6 +481,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units hor_grid, z_grid, t_grid) real, dimension(:,:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -469,7 +489,7 @@ subroutine register_restart_field_3d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -494,6 +514,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units hor_grid, z_grid, t_grid) real, dimension(:,:), & target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -501,7 +522,7 @@ subroutine register_restart_field_2d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, 'h' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, '1' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -528,6 +549,7 @@ end subroutine register_restart_field_2d subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units, conversion, & hor_grid, z_grid, t_grid) real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -535,7 +557,7 @@ subroutine register_restart_field_1d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: hor_grid !< variable horizontal staggering, '1' if absent character(len=*), optional, intent(in) :: z_grid !< variable vertical staggering, 'L' if absent character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent @@ -562,6 +584,7 @@ end subroutine register_restart_field_1d subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units, conversion, & t_grid) real, target, intent(in) :: f_ptr !< A pointer to the field to be read or written + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: name !< variable name to be used in the restart file logical, intent(in) :: mandatory !< If true, the run will abort if this field is not !! successfully read from the restart file. @@ -569,7 +592,7 @@ subroutine register_restart_field_0d(f_ptr, name, mandatory, CS, longname, units character(len=*), optional, intent(in) :: longname !< variable long name character(len=*), optional, intent(in) :: units !< variable units real, optional, intent(in) :: conversion !< A factor to multiply a restart field by - !! before it is written, 1 by default. + !! before it is written [a A-1 ~> 1], 1 by default. character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1, 's' if absent type(vardesc) :: vd @@ -622,7 +645,7 @@ end function query_initialized_name !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_0d(f_ptr, CS) result(query_initialized) - real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried + real, target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -646,7 +669,7 @@ end function query_initialized_0d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_1d(f_ptr, CS) result(query_initialized) - real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried + real, dimension(:), target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -671,7 +694,7 @@ end function query_initialized_1d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_2d(f_ptr, CS) result(query_initialized) real, dimension(:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -696,7 +719,7 @@ end function query_initialized_2d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_3d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -721,7 +744,7 @@ end function query_initialized_3d !> Indicate whether the field pointed to by f_ptr has been initialized from a restart file. function query_initialized_4d(f_ptr, CS) result(query_initialized) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< A pointer to the field that is being queried + target, intent(in) :: f_ptr !< A pointer to the field that is being queried [arbitrary] type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -746,7 +769,7 @@ end function query_initialized_4d !> Indicate whether the field stored in f_ptr or with the specified variable !! name has been initialized from a restart file. function query_initialized_0d_name(f_ptr, name, CS) result(query_initialized) - real, target, intent(in) :: f_ptr !< The field that is being queried + real, target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -779,7 +802,7 @@ end function query_initialized_0d_name !! name has been initialized from a restart file. function query_initialized_1d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -812,7 +835,7 @@ end function query_initialized_1d_name !! name has been initialized from a restart file. function query_initialized_2d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -845,7 +868,7 @@ end function query_initialized_2d_name !! name has been initialized from a restart file. function query_initialized_3d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -878,7 +901,7 @@ end function query_initialized_3d_name !! name has been initialized from a restart file. function query_initialized_4d_name(f_ptr, name, CS) result(query_initialized) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< The field that is being queried + target, intent(in) :: f_ptr !< The field that is being queried [arbitrary] character(len=*), intent(in) :: name !< The name of the field that is being queried type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct logical :: query_initialized @@ -929,7 +952,7 @@ end subroutine set_initialized_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_0d_name(f_ptr, name, CS) - real, target, intent(in) :: f_ptr !< The variable that has been initialized + real, target, intent(in) :: f_ptr !< The variable that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -954,7 +977,7 @@ end subroutine set_initialized_0d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_1d_name(f_ptr, name, CS) real, dimension(:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -979,7 +1002,7 @@ end subroutine set_initialized_1d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_2d_name(f_ptr, name, CS) real, dimension(:,:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -1004,7 +1027,7 @@ end subroutine set_initialized_2d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_3d_name(f_ptr, name, CS) real, dimension(:,:,:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -1029,7 +1052,7 @@ end subroutine set_initialized_3d_name !> Record that the array in f_ptr with the given name has been initialized. subroutine set_initialized_4d_name(f_ptr, name, CS) real, dimension(:,:,:,:), & - target, intent(in) :: f_ptr !< The array that has been initialized + target, intent(in) :: f_ptr !< The array that has been initialized [arbitrary] character(len=*), intent(in) :: name !< The name of the field that has been initialized type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct @@ -1058,6 +1081,7 @@ end subroutine set_initialized_4d_name subroutine only_read_restart_field_4d(varname, f_ptr, G, CS, position, filename, directory, success, scale) character(len=*), intent(in) :: varname !< The variable name to be used in the restart file real, dimension(:,:,:,:), intent(inout) :: f_ptr !< The array for the field to be read + !! in arbitrary rescaled units [A ~> a] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct integer, optional, intent(in) :: position !< A coded integer indicating the horizontal @@ -1067,6 +1091,8 @@ subroutine only_read_restart_field_4d(varname, f_ptr, G, CS, position, filename, character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully real, optional, intent(in) :: scale !< A factor by which the field will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path ! The full path to the file with the variable @@ -1087,6 +1113,7 @@ end subroutine only_read_restart_field_4d subroutine only_read_restart_field_3d(varname, f_ptr, G, CS, position, filename, directory, success, scale) character(len=*), intent(in) :: varname !< The variable name to be used in the restart file real, dimension(:,:,:), intent(inout) :: f_ptr !< The array for the field to be read + !! in arbitrary rescaled units [A ~> a] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct integer, optional, intent(in) :: position !< A coded integer indicating the horizontal @@ -1096,6 +1123,8 @@ subroutine only_read_restart_field_3d(varname, f_ptr, G, CS, position, filename, character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully real, optional, intent(in) :: scale !< A factor by which the field will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path ! The full path to the file with the variable @@ -1116,6 +1145,7 @@ end subroutine only_read_restart_field_3d subroutine only_read_restart_field_2d(varname, f_ptr, G, CS, position, filename, directory, success, scale) character(len=*), intent(in) :: varname !< The variable name to be used in the restart file real, dimension(:,:), intent(inout) :: f_ptr !< The array for the field to be read + !! in arbitrary rescaled units [A ~> a] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct integer, optional, intent(in) :: position !< A coded integer indicating the horizontal @@ -1125,6 +1155,8 @@ subroutine only_read_restart_field_2d(varname, f_ptr, G, CS, position, filename, character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully real, optional, intent(in) :: scale !< A factor by which the field will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path ! The full path to the file with the variable @@ -1146,7 +1178,9 @@ end subroutine only_read_restart_field_2d subroutine only_read_restart_pair_3d(a_ptr, b_ptr, a_name, b_name, G, CS, & stagger, filename, directory, success, scale) real, dimension(:,:,:), intent(inout) :: a_ptr !< The array for the first field to be read + !! in arbitrary rescaled units [A ~> a] real, dimension(:,:,:), intent(inout) :: b_ptr !< The array for the second field to be read + !! in arbitrary rescaled units [A ~> a] character(len=*), intent(in) :: a_name !< The first variable name to be used in the restart file character(len=*), intent(in) :: b_name !< The second variable name to be used in the restart file type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -1157,7 +1191,9 @@ subroutine only_read_restart_pair_3d(a_ptr, b_ptr, a_name, b_name, G, CS, & !! character 'r' to read automatically named files character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. logical, optional, intent(out) :: success !< True if the field was read successfully - real, optional, intent(in) :: scale !< A factor by which the field will be scaled + real, optional, intent(in) :: scale !< A factor by which the fields will be scaled + !! [A a-1 ~> 1] to convert from the units in + !! the file to the internal units of this field ! Local variables character(len=:), allocatable :: file_path_a ! The full path to the file with the first variable @@ -1258,7 +1294,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ ! Local variables type(vardesc) :: vars(CS%max_fields) ! Descriptions of the fields that ! are to be read from the restart file. - type(fieldtype) :: fields(CS%max_fields) ! Opaque types containing metadata describing + type(MOM_field) :: fields(CS%max_fields) ! Opaque types containing metadata describing ! each variable that will be written. character(len=512) :: restartpath ! The restart file path (dir/file). character(len=256) :: restartname ! The restart file name (no dir). @@ -1272,13 +1308,13 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ ! versions of NetCDF, the value was 2147483647_8. integer :: start_var, next_var ! The starting variables of the ! current and next files. - type(file_type) :: IO_handle ! The I/O handle of the open fileset + type(MOM_infra_file) :: IO_handle ! The I/O handle of the open fileset integer :: m, nz integer :: num_files ! The number of restart files that will be used. integer :: seconds, days, year, month, hour, minute character(len=8) :: hor_grid, z_grid, t_grid ! Variable grid info. - real :: conv ! Shorthand for the conversion factor - real :: restart_time + real :: conv ! Shorthand for the conversion factor [a A-1 ~> 1] + real :: restart_time ! The model time at whic the restart file is being written [days] character(len=32) :: filename_appendix = '' ! Appendix to filename for ensemble runs integer :: length ! The length of a text string. integer(kind=8) :: check_val(CS%max_fields,1) @@ -1408,11 +1444,11 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ enddo if (CS%parallel_restartfiles) then - call create_file(IO_handle, trim(restartpath), vars, (next_var-start_var), & - fields, MULTIPLE, G=G, GV=GV, checksums=check_val) + call create_MOM_file(IO_handle, trim(restartpath), vars, next_var-start_var, & + fields, MULTIPLE, G=G, GV=GV, checksums=check_val) else - call create_file(IO_handle, trim(restartpath), vars, (next_var-start_var), & - fields, SINGLE_FILE, G=G, GV=GV, checksums=check_val) + call create_MOM_file(IO_handle, trim(restartpath), vars, next_var-start_var, & + fields, SINGLE_FILE, G=G, GV=GV, checksums=check_val) endif do m=start_var,next_var-1 @@ -1434,7 +1470,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ endif enddo - call close_file(IO_handle) + call IO_handle%close() num_files = num_files+1 @@ -1456,8 +1492,9 @@ subroutine restore_state(filename, directory, day, G, CS) type(MOM_restart_CS), intent(inout) :: CS !< MOM restart control struct ! Local variables - real :: scale ! A scaling factor for reading a field - real :: conv ! The output conversion factor for writing a field + real :: scale ! A scaling factor for reading a field [A a-1 ~> 1] to convert + ! from the units in the file to the internal units of this field + real :: conv ! The output conversion factor for writing a field [a A-1 ~> 1] character(len=512) :: mesg ! A message for warnings. character(len=80) :: varname ! A variable's name. integer :: num_file ! The number of files (restart files and others @@ -1466,14 +1503,14 @@ subroutine restore_state(filename, directory, day, G, CS) integer :: isL, ieL, jsL, jeL integer :: nvar, ntime, pos - type(file_type) :: IO_handles(CS%max_fields) ! The I/O units of all open files. + type(MOM_infra_file) :: IO_handles(CS%max_fields) ! The I/O units of all open files. character(len=200) :: unit_path(CS%max_fields) ! The file names. logical :: unit_is_global(CS%max_fields) ! True if the file is global. character(len=8) :: hor_grid ! Variable grid info. - real :: t1, t2 ! Two times. - real, allocatable :: time_vals(:) - type(fieldtype), allocatable :: fields(:) + real :: t1, t2 ! Two times from the start of different files [days]. + real, allocatable :: time_vals(:) ! Times from a file extracted with getl_file_times [days] + type(MOM_field), allocatable :: fields(:) logical :: is_there_a_checksum ! Is there a valid checksum that should be checked. integer(kind=8) :: checksum_file ! The checksum value recorded in the input file. integer(kind=8) :: checksum_data ! The checksum value for the data that was read in. @@ -1500,7 +1537,7 @@ subroutine restore_state(filename, directory, day, G, CS) ! Get the time from the first file in the list that has one. do n=1,num_file - call get_file_times(IO_handles(n), time_vals, ntime) + call IO_handles(n)%get_file_times(time_vals, ntime) if (ntime < 1) cycle t1 = time_vals(1) @@ -1516,7 +1553,7 @@ 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. do m = n+1,num_file - call get_file_times(IO_handles(n), time_vals, ntime) + call IO_handles(n)%get_file_times(time_vals, ntime) if (ntime < 1) cycle t2 = time_vals(1) @@ -1532,13 +1569,13 @@ subroutine restore_state(filename, directory, day, G, CS) ! Read each variable from the first file in which it is found. do n=1,num_file - call get_file_info(IO_handles(n), nvar=nvar) + call IO_handles(n)%get_file_info(nvar=nvar) allocate(fields(nvar)) - call get_file_fields(IO_handles(n), fields(1:nvar)) + call IO_handles(n)%get_file_fields(fields(1:nvar)) do m=1, nvar - call get_field_atts(fields(m), name=varname) + call IO_handles(n)%get_field_atts(fields(m), name=varname) do i=1,CS%num_obsolete_vars if (adjustl(lowercase(trim(varname))) == adjustl(lowercase(trim(CS%restart_obsolete(i)%field_name)))) then call MOM_error(FATAL, "MOM_restart restore_state: Attempting to use obsolete restart field "//& @@ -1571,11 +1608,11 @@ subroutine restore_state(filename, directory, day, G, CS) call get_checksum_loop_ranges(G, pos, isL, ieL, jsL, jeL) do i=1, nvar - call get_field_atts(fields(i), name=varname) + call IO_handles(n)%get_field_atts(fields(i), name=varname) if (lowercase(trim(varname)) == lowercase(trim(CS%restart_field(m)%var_name))) then checksum_data = -1 if (CS%checksum_required) then - call read_field_chksum(fields(i), checksum_file, is_there_a_checksum) + call IO_handles(n)%read_field_chksum(fields(i), checksum_file, is_there_a_checksum) else checksum_file = -1 is_there_a_checksum = .false. ! Do not need to do data checksumming. @@ -1643,7 +1680,7 @@ subroutine restore_state(filename, directory, day, G, CS) enddo do n=1,num_file - call close_file(IO_handles(n)) + call IO_handles(n)%close() enddo ! Check whether any mandatory fields have not been found. @@ -1745,7 +1782,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct - type(file_type), dimension(:), & + type(MOM_infra_file), dimension(:), & optional, intent(out) :: IO_handles !< The I/O handles of all opened files character(len=*), dimension(:), & optional, intent(out) :: file_paths !< The full paths to open files @@ -1822,7 +1859,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (fexists) then nf = nf + 1 if (present(IO_handles)) & - call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, & + call IO_handles(nf)%open(trim(filepath), READONLY_FILE, & threading=MULTIPLE, fileset=SINGLE_FILE) if (present(global_files)) global_files(nf) = .true. if (present(file_paths)) file_paths(nf) = filepath @@ -1832,7 +1869,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (fexists) then nf = nf + 1 if (present(IO_handles)) & - call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, MOM_domain=G%Domain) + call IO_handles(nf)%open(trim(filepath), READONLY_FILE, MOM_domain=G%Domain) if (present(global_files)) global_files(nf) = .false. if (present(file_paths)) file_paths(nf) = filepath endif @@ -1854,7 +1891,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, if (fexists) then nf = nf + 1 if (present(IO_handles)) & - call open_file(IO_handles(nf), trim(filepath), READONLY_FILE, & + call IO_handles(nf)%open(trim(filepath), READONLY_FILE, & threading=MULTIPLE, fileset=SINGLE_FILE) if (present(global_files)) global_files(nf) = .true. if (present(file_paths)) file_paths(nf) = filepath diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index 6defa492a8..bfc2189188 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -41,7 +41,7 @@ module MOM_unit_scaling real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1 [T m L-1 s-1 ~> 1] real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1 [L s T-1 m-1 ~> 1] real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2 [L s2 T-2 m-1 ~> 1] - real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T1 m2 Z-2 s-1 ~> 1] + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T m2 Z-2 s-1 ~> 1] real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1 [Z2 s T-1 m-2 ~> 1] real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1 [Q R Z m2 T-1 W-1 ~> 1] real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2 [W T Q-1 R-1 Z-1 m-2 ~> 1] @@ -89,31 +89,31 @@ subroutine unit_scaling_init( param_file, US ) call get_param(param_file, mdl, "Z_RESCALE_POWER", Z_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of depths and heights. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "L_RESCALE_POWER", L_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of lateral distances. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "T_RESCALE_POWER", T_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of time. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "R_RESCALE_POWER", R_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of density. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "Q_RESCALE_POWER", Q_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of heat content. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "C_RESCALE_POWER", C_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of temperature. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) call get_param(param_file, mdl, "S_RESCALE_POWER", S_power, & "An integer power of 2 that is used to rescale the model's "//& "internal units of salinity. Valid values range from -300 to 300.", & - units="nondim", default=0, debuggingParam=.true.) + default=0, debuggingParam=.true.) if (abs(Z_power) > 300) call MOM_error(FATAL, "unit_scaling_init: "//& "Z_RESCALE_POWER is outside of the valid range of -300 to 300.") diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index 5277cef1f6..025dcad2ac 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -21,17 +21,17 @@ module MOM_write_cputime !> A control structure that regulates the writing of CPU time type, public :: write_cputime_CS ; private logical :: initialized = .false. !< True if this control structure has been initialized. - real :: maxcpu !< The maximum amount of cpu time per processor + real :: maxcpu !< The maximum amount of CPU time per processor !! for which MOM should run before saving a restart - !! file and quiting with a return value that + !! file and quitting with a return value that !! indicates that further execution is required to - !! complete the simulation, in wall-clock seconds. + !! complete the simulation [wall-clock seconds]. type(time_type) :: Start_time !< The start time of the simulation. !! Start_time is set in MOM_initialization.F90 - real :: startup_cputime !< The CPU time used in the startup phase of the model. - real :: prev_cputime = 0.0 !< The last measured CPU time. - real :: dn_dcpu_min = -1.0 !< The minimum derivative of timestep with CPU time. - real :: cputime2 = 0.0 !< The accumulated cpu time. + real :: startup_cputime !< The CPU time used in the startup phase of the model [clock_cycles]. + real :: prev_cputime = 0.0 !< The last measured CPU time [clock_cycles]. + real :: dn_dcpu_min = -1.0 !< The minimum derivative of timestep with CPU time [steps clock_cycles-1]. + real :: cputime2 = 0.0 !< The accumulated CPU time [clock_cycles]. integer :: previous_calls = 0 !< The number of times write_CPUtime has been called. integer :: prev_n = 0 !< The value of n from the last call. integer :: fileCPU_ascii= -1 !< The unit number of the CPU time file. @@ -76,8 +76,8 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) ! Read all relevant parameters and write them to the model log. - ! Determine whether all paramters are set to their default values. - call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, default=-1.0, do_not_log=.true.) + ! Determine whether all parameters are set to their default values. + call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, units="wall-clock seconds", default=-1.0, do_not_log=.true.) call get_param(param_file, mdl, "CPU_TIME_FILE", CS%CPUfile, default="CPU_stats", do_not_log=.true.) all_default = (CS%maxcpu == -1.0) .and. (trim(CS%CPUfile) == trim("CPU_stats")) @@ -135,10 +135,11 @@ subroutine write_cputime(day, n, CS, nmax, call_end) ! Local variables real :: d_cputime ! The change in CPU time since the last call - ! this subroutine. - integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK - real :: reday ! A real version of day. - integer :: start_of_day, num_days + ! this subroutine [clock_cycles] + integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK [clock_cycles] + real :: reday ! The time in days, including fractional days [days] + integer :: start_of_day ! The number of seconds since the start of the day + integer :: num_days ! The number of days in the time if (.not.associated(CS)) call MOM_error(FATAL, & "write_energy: Module must be initialized before it is used.") diff --git a/src/framework/testing/MOM_file_parser_tests.F90 b/src/framework/testing/MOM_file_parser_tests.F90 index 5ad90caf1b..c0a31c39c4 100644 --- a/src/framework/testing/MOM_file_parser_tests.F90 +++ b/src/framework/testing/MOM_file_parser_tests.F90 @@ -1277,7 +1277,7 @@ subroutine test_log_param_real call create_test_file(param_filename) call open_param_file(param_filename, param) - call log_param(param, module_name, sample_param_name, sample, desc=desc) + call log_param(param, module_name, sample_param_name, sample, desc=desc, units="") call close_param_file(param) end subroutine test_log_param_real @@ -1290,7 +1290,7 @@ subroutine test_log_param_real_array call create_test_file(param_filename) call open_param_file(param_filename, param) - call log_param(param, module_name, sample_param_name, sample, desc=desc) + call log_param(param, module_name, sample_param_name, sample, desc=desc, units="") call close_param_file(param) end subroutine test_log_param_real_array @@ -1468,7 +1468,7 @@ subroutine test_get_param_real call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample) + call get_param(param, module_name, sample_param_name, sample, units="") call close_param_file(param) end subroutine test_get_param_real @@ -1480,7 +1480,7 @@ subroutine test_get_param_real_no_read_no_log call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample, & + call get_param(param, module_name, sample_param_name, sample, units="", & do_not_read=.true., do_not_log=.true.) call close_param_file(param) end subroutine test_get_param_real_no_read_no_log @@ -1493,7 +1493,7 @@ subroutine test_get_param_real_array call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample) + call get_param(param, module_name, sample_param_name, sample, units="") call close_param_file(param) end subroutine test_get_param_real_array @@ -1505,7 +1505,7 @@ subroutine test_get_param_real_array_no_read_no_log call create_test_file(param_filename) call open_param_file(param_filename, param) - call get_param(param, module_name, sample_param_name, sample, & + call get_param(param, module_name, sample_param_name, sample, units="", & do_not_read=.true., do_not_log=.true.) call close_param_file(param) end subroutine test_get_param_real_array_no_read_no_log diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 26c74d73ec..a78c17803c 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -33,7 +33,7 @@ module MOM_ice_shelf use user_initialization, only : user_initialize_topography use MOM_io, only : field_exists, file_exists, MOM_read_data, write_version_number use MOM_io, only : slasher, fieldtype, vardesc, var_desc -use MOM_io, only : write_field, close_file, SINGLE_FILE, MULTIPLE +use MOM_io, only : close_file, SINGLE_FILE, MULTIPLE use MOM_restart, only : register_restart_field, save_restart use MOM_restart, only : restart_init, restore_state, MOM_restart_CS, register_restart_pair use MOM_time_manager, only : time_type, time_type_to_real, real_to_time, operator(>), operator(-) @@ -139,7 +139,7 @@ module MOM_ice_shelf real :: time_step !< this is the shortest timestep that the ice shelf sees [T ~> s], and !! is equal to the forcing timestep (it is passed in when the shelf !! is initialized - so need to reorganize MOM driver. - !! it will be the prognistic timestep ... maybe. + !! it will be the prognostic timestep ... maybe. logical :: solo_ice_sheet !< whether the ice model is running without being !! coupled to the ocean @@ -220,16 +220,16 @@ module MOM_ice_shelf !! formulation (optional to use just two equations). !! See \ref section_ICE_SHELF_equations subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) - type(surface), target, intent(inout) :: sfc_state_in !< A structure containing fields that - !! describe the surface state of the ocean. The - !! intent is only inout to allow for halo updates. - type(forcing), target, intent(inout) :: fluxes_in !< structure containing pointers to any - !! possible thermodynamic or mass-flux forcing fields. - type(time_type), intent(in) :: Time !< Start time of the fluxes. - real, intent(in) :: time_step_in !< Length of time over which these fluxes - !! will be applied [s]. - type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure returned - !! by a previous call to initialize_ice_shelf. + type(surface), target, intent(inout) :: sfc_state_in !< A structure containing fields that + !! describe the surface state of the ocean. The + !! intent is only inout to allow for halo updates. + type(forcing), target, intent(inout) :: fluxes_in !< structure containing pointers to any + !! possible thermodynamic or mass-flux forcing fields. + type(time_type), intent(in) :: Time !< Start time of the fluxes. + real, intent(in) :: time_step_in !< Length of time over which these fluxes + !! will be applied [T ~> s]. + type(ice_shelf_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to initialize_ice_shelf. ! Local variables type(ocean_grid_type), pointer :: G => NULL() !< The grid structure used by the ice shelf. @@ -288,13 +288,13 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: n_star_term ! A term in the expression for nstar [T3 Z-2 ~> s3 m-2] real :: absf ! The absolute value of the Coriolis parameter [T-1 ~> s-1] real :: dIns_dwB !< The partial derivative of I_n_star with wB_flux, in [T3 Z-2 ~> s3 m-2] - real :: dT_ustar ! The difference between the the freezing point and the ocean boundary layer + real :: dT_ustar ! The difference between the freezing point and the ocean boundary layer ! temperature times the friction velocity [C Z T-1 ~> degC m s-1] real :: dS_ustar ! The difference between the salinity at the ice-ocean interface and the ocean ! boundary layer salinity times the friction velocity [S Z T-1 ~> ppt m s-1] real :: ustar_h ! The friction velocity in the water below the ice shelf [Z T-1 ~> m s-1] real :: Gam_turb ! [nondim] - real :: Gam_mol_t, Gam_mol_s ! Relative coefficients of molecular diffusivites [nondim] + real :: Gam_mol_t, Gam_mol_s ! Relative coefficients of molecular diffusivities [nondim] real :: RhoCp ! A typical ocean density times the heat capacity of water [Q R C-1 ~> J m-3 degC-1] real :: ln_neut real :: mass_exch ! A mass exchange rate [R Z T-1 ~> kg m-2 s-1] @@ -312,7 +312,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real :: Irho0 ! The inverse of the mean density times a unit conversion factor [R-1 L Z-1 ~> m3 kg-1] logical :: Sb_min_set, Sb_max_set logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. - logical :: coupled_GL ! If true, the grouding line position is determined based on + logical :: coupled_GL ! If true, the grounding line position is determined based on ! coupled ice-ocean dynamics. real, parameter :: c2_3 = 2.0/3.0 @@ -326,7 +326,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) G => CS%grid ; US => CS%US ISS => CS%ISS - time_step = US%s_to_T*time_step_in + time_step = time_step_in if (CS%data_override_shelf_fluxes .and. CS%active_shelf_dynamics) then call data_override(G%Domain, 'shelf_sfc_mass_flux', fluxes_in%shelf_sfc_mass_flux, CS%Time, & @@ -524,7 +524,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) wB_flux = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * wT_flux if (wB_flux < 0.0) then - ! The buoyancy flux is stabilizing and will reduce the tubulent + ! The buoyancy flux is stabilizing and will reduce the turbulent ! fluxes, and iteration is required. n_star_term = (ZETA_N/RC) * (hBL_neut * VK) / (ustar_h)**3 do it3 = 1,30 @@ -572,9 +572,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) exch_vel_s(i,j) = ustar_h * I_Gam_S ! Calculate the heat flux inside the ice shelf. - ! Vertical adv/diff as in H+J 1999, eqns (26) & approx from (31). + ! Vertical adv/diff as in H+J 1999, equations (26) & approx from (31). ! Q_ice = density_ice * CS%Cp_ice * K_ice * dT/dz (at interface) - ! vertical adv/diff as in H+J 1999, eqs (31) & (26)... + ! vertical adv/diff as in H+J 1999, equations (31) & (26)... ! dT/dz ~= min( (lprec/(density_ice*K_ice))*(CS%Temp_Ice-T_freeze) , 0.0 ) ! If this approximation is not made, iterations are required... See H+J Fig 3. @@ -1012,7 +1012,7 @@ subroutine add_shelf_flux(G, US, CS, sfc_state, fluxes) real :: balancing_area !< total area where the balancing flux is applied [m2] type(time_type) :: dTime !< The time step as a time_type type(time_type) :: Time0 !< The previous time (Time-dt) - real, dimension(SZDI_(G),SZDJ_(G)) :: bal_frac !< Fraction of the cel1 where the mass flux + real, dimension(SZDI_(G),SZDJ_(G)) :: bal_frac !< Fraction of the cell where the mass flux !! balancing the net melt flux occurs, 0 to 1 [nondim] real, dimension(SZDI_(G),SZDJ_(G)) :: last_mass_shelf !< Ice shelf mass !! at at previous time (Time-dt) [R Z ~> kg m-2] @@ -1235,13 +1235,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, logical :: new_sim, save_IC !This include declares and sets the variable "version". # include "version_variable.h" - character(len=200) :: IC_file, inputdir + character(len=200) :: IC_file, inputdir ! Input file names or paths character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq integer :: wd_halos(2) logical :: read_TideAmp, shelf_mass_is_dynamic, debug logical :: global_indexing - character(len=240) :: Tideamp_file + character(len=240) :: Tideamp_file ! Input file names + character(len=80) :: tideamp_var ! Input file variable names real :: utide ! A tidal velocity [L T-1 ~> m s-1] real :: col_thick_melt_thresh ! An ocean column thickness below which iceshelf melting ! does not occur [Z ~> m] @@ -1397,7 +1398,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "consistency to calculate the fluxes at the ice-ocean "//& "interface.", default=.true.) call get_param(param_file, mdl, "SHELF_INSULATOR", CS%insulator, & - "If true, the ice shelf is a perfect insulatior "//& + "If true, the ice shelf is a perfect insulator "//& "(no conduction).", default=.false.) call get_param(param_file, mdl, "MELTING_CUTOFF_DEPTH", CS%cutoff_depth, & "Depth above which the melt is set to zero (it must be >= 0) "//& @@ -1467,7 +1468,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) + units="m s-2", default=9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "C_P", CS%Cp, & "The heat capacity of sea water, approximated as a constant. "//& "The default value is from the TEOS-10 definition of conservative temperature.", & @@ -1491,7 +1492,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "The viscosity of the ice.", & units="m2 s-1", default=1.0e10, scale=US%Z_to_L**2*US%m_to_L**2*US%T_to_s) call get_param(param_file, mdl, "KV_MOLECULAR", CS%kv_molec, & - "The molecular kinimatic viscosity of sea water at the freezing temperature.", & + "The molecular kinematic viscosity of sea water at the freezing temperature.", & units="m2 s-1", default=1.95e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "ICE_SHELF_SALINITY", CS%Salin_ice, & "The salinity of the ice inside the ice shelf.", & @@ -1537,19 +1538,21 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, if (read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying "//& - "tidal amplitudes.", & + "The path to the file containing the spatially varying tidal amplitudes.", & default="tideamp.nc") - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") 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), 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 MOM_read_data(TideAmp_file, tideamp_var, tmp2d, CS%Grid_in%domain, timelevel=1, scale=US%m_s_to_L_T) call rotate_array(tmp2d, CS%turns, CS%utide) deallocate(tmp2d) else - call MOM_read_data(TideAmp_file, 'tideamp', CS%utide, CS%Grid%domain, timelevel=1, scale=US%m_s_to_L_T) + call MOM_read_data(TideAmp_file, tideamp_var, CS%utide, CS%Grid%domain, timelevel=1, scale=US%m_s_to_L_T) endif else call get_param(param_file, mdl, "UTIDE", utide, & @@ -1691,7 +1694,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, !GMM - I think we do not need to save ustar_shelf and iceshelf_melt in the restart file !if (.not. CS%solo_ice_sheet) then ! call register_restart_field(fluxes%ustar_shelf, "ustar_shelf", .false., CS%restart_CSp, & - ! "Friction velocity under ice shelves", "m s-1", conversion=###) + ! "Friction velocity under ice shelves", "m s-1", conversion=US%Z_to_m*US%s_to_T) !endif CS%restart_output_dir = dirs%restart_output_dir @@ -1794,7 +1797,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, endif CS%id_area_shelf_h = register_diag_field('ice_shelf_model', 'area_shelf_h', CS%diag%axesT1, CS%Time, & - 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) + 'Ice Shelf Area in cell', 'meter2', conversion=US%L_to_m**2) CS%id_shelf_mass = register_diag_field('ice_shelf_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & 'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2) CS%id_h_shelf = register_diag_field('ice_shelf_model', 'h_shelf', CS%diag%axesT1, CS%Time, & @@ -1836,7 +1839,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, CS%id_h_mask = register_diag_field('ice_shelf_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') CS%id_shelf_sfc_mass_flux = register_diag_field('ice_shelf_model', 'sfc_mass_flux', CS%diag%axesT1, CS%Time, & - 'ice shelf surface mass flux deposition from atmosphere', 'none', conversion=US%RZ_T_to_kg_m2s) + 'ice shelf surface mass flux deposition from atmosphere', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) endif call MOM_IS_diag_mediator_close_registration(CS%diag) @@ -2192,7 +2196,7 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in real :: min_time_step ! The minimal required timestep that would indicate a fatal problem [T ~> s] character(len=240) :: mesg logical :: update_ice_vel ! If true, it is time to update the ice shelf velocities. - logical :: coupled_GL ! If true the grouding line position is determined based on + logical :: coupled_GL ! If true the grounding line position is determined based on ! coupled ice-ocean dynamics. integer :: is, iec, js, jec @@ -2261,7 +2265,7 @@ end subroutine solo_step_ice_shelf !! update_shelf_mass - updates ice shelf mass via netCDF file !! USER_update_shelf_mass (TODO). !! solo_step_ice_shelf - called only in ice-only mode. -!! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. currently mass_shelf is +!! shelf_calc_flux - after melt rate & fluxes are calculated, ice dynamics are done. Currently mass_shelf is !! updated immediately after ice_shelf_advect in fully dynamic mode. !! !! NOTES: be aware that hmask(:,:) has a number of functions; it is used for front advancement, diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 479b1dfd1e..dabb075cf3 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -42,8 +42,9 @@ module MOM_IS_diag_mediator integer :: fms_diag_id !< underlying FMS diag id character(len=24) :: name !< The diagnostic name real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. - real, pointer, dimension(:,:) :: mask2d => null() !< A 2-d mask on the data domain for this diagnostic - real, pointer, dimension(:,:) :: mask2d_comp => null() !< A 2-d mask on the computational domain for this diagnostic + real, pointer, dimension(:,:) :: mask2d => null() !< A 2-d mask on the data domain for this diagnostic [nondim] + real, pointer, dimension(:,:) :: mask2d_comp => null() !< A 2-d mask on the computational domain + !! for this diagnostic [nondim] end type diag_type !> The SIS_diag_ctrl data type contains times to regulate diagnostics along with masks and @@ -64,7 +65,7 @@ module MOM_IS_diag_mediator integer :: ied !< The end i-index of cell centers within the data domain integer :: jsd !< The start j-index of cell centers within the data domain integer :: jed !< The end j-index of cell centers within the data domain - real :: time_int !< The time interval in s for any fields that are offered for averaging. + real :: time_int !< The time interval for any fields that are offered for averaging [s]. type(time_type) :: time_end !< The end time of the valid interval for any offered field. logical :: ave_enabled = .false. !< .true. if averaging is enabled. @@ -89,7 +90,7 @@ module MOM_IS_diag_mediator #define DIAG_ALLOC_CHUNK_SIZE 15 type(diag_type), dimension(:), allocatable :: diags !< The array of diagnostics integer :: next_free_diag_id !< The next unused diagnostic ID - !> default missing value to be sent to ALL diagnostics registerations + !> default missing value to be sent to ALL diagnostics registerations [various] real :: missing_value = -1.0e34 type(unit_scale_type), pointer :: US => null() !< A dimensional unit scaling type @@ -101,8 +102,8 @@ module MOM_IS_diag_mediator !> Set up the grid and axis information for use by the ice shelf model. subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) type(ocean_grid_type), intent(inout) :: G !< The horizontal grid type - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output character(len=*), optional, intent(in) :: axes_set_name !< A name to use for this set of axes. !! The default is "ice". ! This subroutine sets up the grid and axis information for use by the ice shelf model. @@ -111,8 +112,8 @@ subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) integer :: id_xq, id_yq, id_xh, id_yh logical :: Cartesian_grid character(len=80) :: grid_config, units_temp, set_name -! 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_IS_diag_mediator" ! This module's name. set_name = "ice_shelf" ; if (present(axes_set_name)) set_name = trim(axes_set_name) @@ -128,8 +129,9 @@ subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) "\t spherical - a spherical grid \n"//& "\t mercator - a Mercator grid", fail_if_missing=.true.) - G%x_axis_units = "degrees_E" - G%y_axis_units = "degrees_N" + G%x_axis_units = "degrees_E" ; G%y_axis_units = "degrees_N" + G%x_ax_unit_short = "degrees_E" ; G%y_ax_unit_short = "degrees_N" + if (index(lowercase(trim(grid_config)),"cartesian") > 0) then ! This is a cartesian grid, and may have different axis units. Cartesian_grid = .true. @@ -141,8 +143,10 @@ subroutine set_IS_axes_info(G, param_file, diag_cs, axes_set_name) "implemented.", default='degrees') if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" + G%x_ax_unit_short = "km" ; G%y_ax_unit_short = "km" elseif (units_temp(1:1) == 'm') then G%x_axis_units = "meters" ; G%y_axis_units = "meters" + G%x_ax_unit_short = "m" ; G%y_ax_unit_short = "m" endif call log_param(param_file, mdl, "explicit AXIS_UNITS", G%x_axis_units) else @@ -343,12 +347,11 @@ end subroutine post_IS_data !> Enable the accumulation of time averages over the specified time interval. subroutine enable_averaging(time_int_in, time_end_in, diag_cs) - real, intent(in) :: time_int_in !< The time interval over which any values -! !! that are offered are valid [s]. - type(time_type), intent(in) :: time_end_in !< The end time of the valid interval. - type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output -! This subroutine enables the accumulation of time averages over the -! specified time interval. + real, intent(in) :: time_int_in !< The time interval over which any values + !! that are offered are valid [s]. + type(time_type), intent(in) :: time_end_in !< The end time of the valid interval. + type(diag_ctrl), intent(inout) :: diag_cs !< A structure that is used to regulate diagnostic output + ! This subroutine enables the accumulation of time averages over the specified time interval. ! if (num_file==0) return diag_cs%time_int = time_int_in @@ -371,8 +374,8 @@ subroutine enable_averages(time_int, time_end, diag_CS, T_to_s) !! that are offered are valid [T ~> s]. type(time_type), intent(in) :: time_end !< The end time of the valid interval. type(diag_ctrl), intent(inout) :: diag_CS !< A structure that is used to regulate diagnostic output - real, optional, intent(in) :: T_to_s !< A conversion factor for time_int to [s]. -! This subroutine enables the accumulation of time averages over the specified time interval. + real, optional, intent(in) :: T_to_s !< A conversion factor for time_int to seconds [s T-1 ~> 1]. + ! This subroutine enables the accumulation of time averages over the specified time interval. if (present(T_to_s)) then diag_cs%time_int = time_int*T_to_s diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 63ccc3d33c..3049cae00c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -46,9 +46,9 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: v_shelf => NULL() !< the meridional velocity of the ice shelf/sheet !! on q-points (B grid) [L T-1 ~> m s-1] real, pointer, dimension(:,:) :: taudx_shelf => NULL() !< the driving stress of the ice shelf/sheet - !! on q-points (C grid) [Pa ~> Pa] + !! on q-points (C grid) [R L2 T-2 ~> Pa] real, pointer, dimension(:,:) :: taudy_shelf => NULL() !< the meridional stress of the ice shelf/sheet - !! on q-points (C grid) [Pa ~> Pa] + !! on q-points (C grid) [R L2 T-2 ~> Pa] real, pointer, dimension(:,:) :: u_face_mask => NULL() !< mask for velocity boundary conditions on the C-grid !! u-face - this is because the FEM cares about FACES THAT GET INTEGRATED OVER, !! not vertices. Will represent boundary conditions on computational boundary @@ -77,9 +77,10 @@ module MOM_ice_shelf_dynamics real, pointer, dimension(:,:) :: t_shelf => NULL() !< Vertically integrated temperature in the ice shelf/stream, !! on corner-points (B grid) [C ~> degC] real, pointer, dimension(:,:) :: tmask => NULL() !< A mask on tracer points that is 1 where there is ice. - real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity, often in [R L4 Z T-1 ~> kg m2 s-1]. + real, pointer, dimension(:,:) :: ice_visc => NULL() !< Glen's law ice viscosity (Pa s), + !! in [R L2 T-1 ~> kg m-1 s-1]. real, pointer, dimension(:,:) :: AGlen_visc => NULL() !< Ice-stiffness parameter in Glen's law ice viscosity, - !! often in [kg-1/3 m-1/3 s-1]. + !! often in [Pa-3 s-1] if n_Glen is 3. real, pointer, dimension(:,:) :: thickness_bdry_val => NULL() !< The ice thickness at an inflowing boundary [Z ~> m]. real, pointer, dimension(:,:) :: u_bdry_val => NULL() !< The zonal ice velocity at inflowing boundaries !! [L yr-1 ~> m yr-1] @@ -94,7 +95,7 @@ module MOM_ice_shelf_dynamics !! 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]. + !! basal stress (Pa) [R L2 T-2 ~> Pa]. !! The exact form depends on basal law exponent and/or whether flow is "hybridized" a la Goldberg 2011 real, pointer, dimension(:,:) :: C_basal_friction => NULL()!< Coefficient in sliding law tau_b = C u^(n_basal_fric), !! units= Pa (m yr-1)-(n_basal_fric) @@ -117,6 +118,9 @@ module MOM_ice_shelf_dynamics real :: g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: density_ice !< A typical density of ice [R ~> kg m-3]. + character(len=40) :: ice_viscosity_compute !< Specifies whether the ice viscosity is computed internally + !! according to Glen's flow law; is constant (for debugging purposes) + !! or using observed strain rates and read from a file logical :: GL_regularize !< Specifies whether to regularize the floatation condition !! at the grounding line as in Goldberg Holland Schoof 2009 integer :: n_sub_regularize @@ -143,11 +147,11 @@ module MOM_ice_shelf_dynamics logical :: moving_shelf_front !< Specify whether to advance shelf front (and calve). logical :: calve_to_mask !< If true, calve off the ice shelf when it passes the edge of a mask. real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. - + real :: T_shelf_missing !< An ice shelf temperature to use where there is no ice shelf [C ~> degC] real :: cg_tolerance !< The tolerance in the CG solver, relative to initial residual, that - !! determines when to stop the conjugate gradient iterations. + !! determines when to stop the conjugate gradient iterations [nondim]. real :: nonlinear_tolerance !< The fractional nonlinear tolerance, relative to the initial error, - !! that sets when to stop the iterative velocity solver + !! that sets when to stop the iterative velocity solver [nondim] integer :: cg_max_iterations !< The maximum number of iterations that can be used in the CG solver integer :: nonlin_solve_err_mode !< 1: exit vel solve based on nonlin residual !! 2: exit based on "fixed point" metric (|u - u_last| / |u| < tol) where | | is infty-norm @@ -230,6 +234,8 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) type(ice_shelf_dyn_CS), pointer :: CS !< A pointer to the ice shelf dynamics control structure type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + ! Local variables + real :: T_shelf_missing ! An ice shelf temperature to use where there is no ice shelf [C ~> degC] logical :: shelf_mass_is_dynamic, override_shelf_movement, active_shelf_dynamics character(len=40) :: mdl = "MOM_ice_shelf_dyn" ! This module's name. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -256,12 +262,15 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) endif if (active_shelf_dynamics) then + call get_param(param_file, mdl, "MISSING_SHELF_TEMPERATURE", T_shelf_missing, & + "An ice shelf temperature to use where there is no ice shelf.",& + units="degC", default=-10.0, scale=US%degC_to_C, do_not_log=.true.) allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) - allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0*US%degC_to_C ) ! [C ~> degC] + allocate( CS%t_shelf(isd:ied,jsd:jed), source=T_shelf_missing ) ! [C ~> degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3 s-1] - allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) ! [R L2 T-2 ~> Pa] allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) @@ -325,6 +334,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! a restart file to the internal representation in this run. real :: vel_rescale ! A rescaling factor for horizontal velocities from the representation ! in a restart file to the internal representation in this run. + real :: T_shelf_bdry ! A default ice shelf temperature to use for ice flowing + ! in through open boundaries [C ~> degC] !This include declares and sets the variable "version". # include "version_variable.h" character(len=200) :: IC_file,filename,inputdir @@ -385,7 +396,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & "A factor used to limit timestep as CFL_FACTOR * min (\Delta x / u). "//& - "This is only used with an ice-only model.", default=0.25) + "This is only used with an ice-only model.", units="nondim", default=0.25) endif call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & "avg ocean density used in floatation cond", & @@ -396,7 +407,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ fail_if_missing=.true.) call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) + units="m s-2", default=9.80, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & @@ -410,9 +421,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & - "tolerance in CG solver, relative to initial residual", default=1.e-6) + "tolerance in CG solver, relative to initial residual", units="nondim", default=1.e-6) call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", CS%nonlinear_tolerance, & - "nonlin tolerance in iterative velocity solve",default=1.e-6) + "nonlin tolerance in iterative velocity solve", units="nondim", default=1.e-6) call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & "max iteratiions in CG solver", default=2000) call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & @@ -429,8 +440,18 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "If true, do not allow an ice shelf where prohibited by a mask.", & default=.false.) - + call get_param(param_file, mdl, "ICE_VISCOSITY_COMPUTE", CS%ice_viscosity_compute, & + "If MODEL, compute ice viscosity internally, if OBS read from a file,"//& + "if CONSTANT a constant value (for debugging).", & + default="MODEL") + + call get_param(param_file, mdl, "INFLOW_SHELF_TEMPERATURE", T_shelf_bdry, & + "A default ice shelf temperature to use for ice flowing in through "//& + "open boundaries.", units="degC", default=-15.0, scale=US%degC_to_C) endif + call get_param(param_file, mdl, "MISSING_SHELF_TEMPERATURE", CS%T_shelf_missing, & + "An ice shelf temperature to use where there is no ice shelf.",& + units="degC", default=-10.0, scale=US%degC_to_C) call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& units="m", default=0.0, scale=US%m_to_Z) @@ -439,7 +460,7 @@ 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), source=-15.0*US%degC_to_C) ! [C ~> degC] + allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=T_shelf_bdry) ! [C ~> 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) @@ -581,7 +602,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 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, & - 'vi-viscosity', 'Pa s-1 m', conversion=US%RL2_T2_to_Pa*US%L_T_to_m_s) !vertically integrated viscosity + 'vi-viscosity', 'Pa m s', conversion=US%RL2_T2_to_Pa*US%Z_to_m*US%T_to_s) !vertically integrated viscosity CS%id_taub = register_diag_field('ice_shelf_model','taub_beta',CS%diag%axesT1, Time, & 'taub', 'MPa', conversion=1e-6*US%RL2_T2_to_Pa) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & @@ -675,10 +696,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - real, dimension(SZDIB_(G),SZDJB_(G)) ::taud_x,taud_y ! Pa] - real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc ! Pa s-1 m] - real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr ! Pa] + real, dimension(SZDIB_(G),SZDJB_(G)) :: taud_x, taud_y ! Pa] + real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc !< area-averaged vertically integrated ice viscosity + !! [R L2 Z T-1 ~> Pa s m] + real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr !< area-averaged basal traction [R L2 T-2 ~> Pa] integer :: iters logical :: update_ice_vel, coupled_GL @@ -1290,7 +1311,7 @@ subroutine ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H ! R,u,v,Z valid region moves in by 1 - ! beta_k = (Z \dot R) / (Zold \dot Rold} + ! beta_k = (Z \dot R) / (Zold \dot Rold) sum_vec(:,:) = 0.0 ; sum_vec_2(:,:) = 0.0 do j=jscq,jecq ; do i=iscq,iecq @@ -1407,7 +1428,7 @@ subroutine ice_shelf_advect_thickness_x(CS, G, LB, time_step, hmask, h0, h_after do j=jsh,jeh ; do I=ish-1,ieh if (CS%u_face_mask(I,j) == 4.) then ! The flux itself is a specified boundary condition. uh_ice(I,j) = time_step * G%dyCu(I,j) * CS%u_flux_bdry_val(I,j) - elseif ((hmask(i,j)==1) .or. (hmask(i+1,j) == 1)) then + elseif ((hmask(i,j) == 1) .or. (hmask(i+1,j) == 1)) then u_face = 0.5 * (CS%u_shelf(I,J-1) + CS%u_shelf(I,J)) h_face = 0.0 ! This will apply when the source cell is iceless or not fully ice covered. @@ -1486,7 +1507,7 @@ subroutine ice_shelf_advect_thickness_y(CS, G, LB, time_step, hmask, h0, h_after do J=jsh-1,jeh ; do i=ish,ieh if (CS%v_face_mask(i,J) == 4.) then ! The flux itself is a specified boundary condition. vh_ice(i,J) = time_step * G%dxCv(i,J) * CS%v_flux_bdry_val(i,J) - elseif ((hmask(i,j)==1) .or. (hmask(i,j+1) == 1)) then + elseif ((hmask(i,j) == 1) .or. (hmask(i,j+1) == 1)) then v_face = 0.5 * (CS%v_shelf(I-1,J) + CS%v_shelf(I,J)) h_face = 0.0 ! This will apply when the source cell is iceless or not fully ice covered. @@ -1785,10 +1806,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, dimension(SZDI_(G),SZDJ_(G)), & intent(in) :: OD !< ocean floor depth at tracer points [Z ~> m]. real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: taudx !< X-direction driving stress at q-points [kg L s-2 ~> kg m s-2] + intent(inout) :: taudx !< X-direction driving stress at q-points [R L3 Z T-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)), & - intent(inout) :: taudy !< Y-direction driving stress at q-points [kg L s-2 ~> kg m s-2] - ! This will become [R L3 Z T-2 ~> kg m s-2] + intent(inout) :: taudy !< Y-direction driving stress at q-points [R L3 Z T-2 ~> kg m s-2] + ! driving stress! @@ -1806,7 +1827,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. - real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] @@ -1846,7 +1866,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) else - S(i,j)=ISS%h_shelf(i,j)-CS%bed_elev(i,j) + S(i,j) = ISS%h_shelf(i,j)-CS%bed_elev(i,j) endif enddo enddo @@ -1961,13 +1981,12 @@ 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 * CS%bed_elev(i,j)**2)) - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 + neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2)) else neumann_val = (.5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2) endif - if ((CS%u_face_mask(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then + if ((CS%u_face_mask_bdry(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then ! left face of the cell is at a stress boundary ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated ! pressure on either side of the face @@ -1981,19 +2000,19 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudx(I-1,J) = taudx(I-1,J) - .5 * dyh * neumann_val endif - if ((CS%u_face_mask(I,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then + if ((CS%u_face_mask_bdry(I,j) == 2) .OR. (ISS%hmask(i+1,j) == 0) .OR. (ISS%hmask(i+1,j) == 2) ) then ! east face of the cell is at a stress boundary taudx(I,J-1) = taudx(I,J-1) + .5 * dyh * neumann_val taudx(I,J) = taudx(I,J) + .5 * dyh * neumann_val endif - if ((CS%v_face_mask(i,J-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then + if ((CS%v_face_mask_bdry(i,J-1) == 2) .OR. (ISS%hmask(i,j-1) == 0) .OR. (ISS%hmask(i,j-1) == 2) ) then ! south face of the cell is at a stress boundary taudy(I-1,J-1) = taudy(I-1,J-1) - .5 * dxh * neumann_val taudy(I,J-1) = taudy(I,J-1) - .5 * dxh * neumann_val endif - if ((CS%v_face_mask(i,J) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then + if ((CS%v_face_mask_bdry(i,J) == 2) .OR. (ISS%hmask(i,j+1) == 0) .OR. (ISS%hmask(i,j+1) == 2) ) then ! north face of the cell is at a stress boundary taudy(I-1,J) = taudy(I-1,J) + .5 * dxh * neumann_val taudy(I,J) = taudy(I,J) + .5 * dxh * neumann_val @@ -2212,12 +2231,12 @@ subroutine CG_action(uret, vret, u_shlf, v_shlf, Phi, Phisub, umask, vmask, hmas Hcell(:,:) = H_node(i-1:i,j-1:j) call CG_action_subgrid_basal(Phisub, Hcell, Ucell, Vcell, bathyT(i,j), dens_ratio, Usub, Vsub) - if (umask(I-1,J-1)==1) uret(I-1,J-1) = uret(I-1,J-1) + Usub(1,1) * basal_trac(i,j) + if (umask(I-1,J-1) == 1) uret(I-1,J-1) = uret(I-1,J-1) + Usub(1,1) * basal_trac(i,j) if (umask(I-1,J) == 1) uret(I-1,J) = uret(I-1,J) + Usub(1,2) * basal_trac(i,j) if (umask(I,J-1) == 1) uret(I,J-1) = uret(I,J-1) + Usub(2,1) * basal_trac(i,j) if (umask(I,J) == 1) uret(I,J) = uret(I,J) + Usub(2,2) * basal_trac(i,j) - if (vmask(I-1,J-1)==1) vret(I-1,J-1) = vret(I-1,J-1) + Vsub(1,1) * basal_trac(i,j) + if (vmask(I-1,J-1) == 1) vret(I-1,J-1) = vret(I-1,J-1) + Vsub(1,1) * basal_trac(i,j) if (vmask(I-1,J) == 1) vret(I-1,J) = vret(I-1,J) + Vsub(1,2) * basal_trac(i,j) if (vmask(I,J-1) == 1) vret(I,J-1) = vret(I,J-1) + Vsub(2,1) * basal_trac(i,j) if (vmask(I,J) == 1) vret(I,J) = vret(I,J) + Vsub(2,2) * basal_trac(i,j) @@ -2543,12 +2562,12 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, 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) + 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) if (CS%umask(I-1,J) == 1) u_bdry_contr(I-1,J) = u_bdry_contr(I-1,J) + Usubcontr(1,2) * basal_trac(i,j) if (CS%umask(I,J-1) == 1) u_bdry_contr(I,J-1) = u_bdry_contr(I,J-1) + Usubcontr(2,1) * basal_trac(i,j) if (CS%umask(I,J) == 1) u_bdry_contr(I,J) = u_bdry_contr(I,J) + Usubcontr(2,2) * basal_trac(i,j) - if (CS%vmask(I-1,J-1)==1) v_bdry_contr(I-1,J-1) = v_bdry_contr(I-1,J-1) + Vsubcontr(1,1) * basal_trac(i,j) + if (CS%vmask(I-1,J-1) == 1) v_bdry_contr(I-1,J-1) = v_bdry_contr(I-1,J-1) + Vsubcontr(1,1) * basal_trac(i,j) if (CS%vmask(I-1,J) == 1) v_bdry_contr(I-1,J) = v_bdry_contr(I-1,J) + Vsubcontr(1,2) * basal_trac(i,j) if (CS%vmask(I,J-1) == 1) v_bdry_contr(I,J-1) = v_bdry_contr(I,J-1) + Vsubcontr(2,1) * basal_trac(i,j) if (CS%vmask(I,J) == 1) v_bdry_contr(I,J) = v_bdry_contr(I,J) + Vsubcontr(2,2) * basal_trac(i,j) @@ -2560,7 +2579,7 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, end subroutine apply_boundary_values -!> Update depth integrated viscosity, based on horizontal strain rates, and also update the +!> Update depth integrated viscosity, based on horizontal strain rates subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe @@ -2575,7 +2594,6 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) ! quadrature points surrounding the cell vertices [L-1 ~> m-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve -! also this subroutine updates the nonlinear part of the basal traction ! this may be subject to change later... to make it "hybrid" ! real, dimension(SZDIB_(G),SZDJB_(G)) :: eII, ux, uy, vx, vy @@ -2604,13 +2622,13 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) enddo ; enddo n_g = CS%n_glen; eps_min = CS%eps_glen_min - CS%ice_visc(:,:)=1e22 + CS%ice_visc(:,:) = 1.0e22 ! Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) do j=jsc,jec ; do i=isc,iec if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then - Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%AGlen_visc(i,j))**(-1./CS%n_glen) - + Visc_coef = ( (US%RL2_T2_to_Pa)**(-CS%n_glen)*US%T_to_s )**(-1./CS%n_glen) * (CS%AGlen_visc(i,j))**(-1./CS%n_glen) + ! Units of Aglen_visc [Pa-3 s-1] do iq=1,2 ; do jq=1,2 ux = ( (u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & @@ -2633,14 +2651,23 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) enddo ; enddo -! 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)) + if (trim(CS%ice_viscosity_compute) == "CONSTANT") then + CS%ice_visc(i,j) = 1e15 * US%kg_m3_to_R*US%m_to_L*US%m_s_to_L_T * (G%areaT(i,j) * ISS%h_shelf(i,j)) + ! constant viscocity for debugging + elseif (trim(CS%ice_viscosity_compute) == "MODEL") then + CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & + (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) + elseif (trim(CS%ice_viscosity_compute) == "OBS") then + if (CS%AGlen_visc(i,j) >0) CS%ice_visc(i,j) = CS%AGlen_visc(i,j)*(G%areaT(i,j) * ISS%h_shelf(i,j)) + ! Here CS%Aglen_visc(i,j) is the ice viscocity [Pa s-1] computed from obs and read from a file + endif endif enddo ; enddo deallocate(Phi) end subroutine calc_shelf_visc + +!> Update basal shear subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe @@ -2993,23 +3020,23 @@ 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)=3. - u_face_mask(I-1+k,j)=3. - umask(I-1+k,J)=3. - vmask(I-1+k,J)=3. - vmask(I-1+k,J)=3. + 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) = 3. + vmask(I-1+k,J) = 3. case (2) - u_face_mask(I-1+k,j)=2. + u_face_mask(I-1+k,j) = 2. case (4) - umask(I-1+k,J-1:J)=0. - vmask(I-1+k,J-1:J)=0. - u_face_mask(I-1+k,j)=4. + umask(I-1+k,J-1:J) = 0. + vmask(I-1+k,J-1:J) = 0. + u_face_mask(I-1+k,j) = 4. case (0) - umask(I-1+k,J-1:J)=0. - vmask(I-1+k,J-1:J)=0. - u_face_mask(I-1+k,j)=0. + umask(I-1+k,J-1:J) = 0. + vmask(I-1+k,J-1:J) = 0. + u_face_mask(I-1+k,j) = 0. case (1) ! stress free x-boundary - umask(I-1+k,J-1:J)=0. + umask(I-1+k,J-1:J) = 0. case default end select enddo @@ -3018,23 +3045,23 @@ 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)=3. - vmask(I,J-1+k)=3. - umask(I,J-1+k)=3. - v_face_mask(i,J-1+k)=3. + vmask(I-1,J-1+k) = 3. + umask(I-1,J-1+k) = 3. + vmask(I,J-1+k) = 3. + umask(I,J-1+k) = 3. + v_face_mask(i,J-1+k) = 3. case (2) - v_face_mask(i,J-1+k)=2. + v_face_mask(i,J-1+k) = 2. case (4) - umask(I-1:I,J-1+k)=0. - vmask(I-1:I,J-1+k)=0. - v_face_mask(i,J-1+k)=4. + umask(I-1:I,J-1+k) = 0. + vmask(I-1:I,J-1+k) = 0. + v_face_mask(i,J-1+k) = 4. case (0) - umask(I-1:I,J-1+k)=0. - vmask(I-1:I,J-1+k)=0. - v_face_mask(i,J-1+k)=0. + umask(I-1:I,J-1+k) = 0. + vmask(I-1:I,J-1+k) = 0. + v_face_mask(i,J-1+k) = 0. case (1) ! stress free y-boundary - vmask(I-1:I,J-1+k)=0. + vmask(I-1:I,J-1+k) = 0. case default end select enddo @@ -3172,8 +3199,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) real, dimension(SZDI_(G),SZDJ_(G)) :: th_after_uflux, th_after_vflux, TH ! Integrated temperatures [C Z ~> degC m] integer :: isd, ied, jsd, jed, i, j, isc, iec, jsc, jec real :: Tsurf ! Surface air temperature [C ~> degC]. This is hard coded but should be an input argument. - real :: adot ! A surface heat exchange coefficient divided by the heat capacity of - ! ice [R Z T-1 degC-1 ~> kg m-2 s-1 degC-1]. + real :: adot ! A surface heat exchange coefficient [R Z T-1 ~> kg m-2 s-1]. ! For now adot and Tsurf are defined here adot=surf acc 0.1m/yr, Tsurf=-20oC, vary them later @@ -3208,7 +3234,7 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) if (ISS%h_shelf(i,j) > 0.0) then CS%t_shelf(i,j) = th_after_vflux(i,j) / ISS%h_shelf(i,j) else - CS%t_shelf(i,j) = -10.0*US%degC_to_C + CS%t_shelf(i,j) = CS%T_shelf_missing endif ! endif @@ -3219,11 +3245,11 @@ subroutine ice_shelf_temp(CS, ISS, G, US, time_step, melt_rate, Time) else ! the ice is about to melt away in this case set thickness, area, and mask to zero ! NOTE: not mass conservative, should maybe scale salt & heat flux for this cell - CS%t_shelf(i,j) = -10.0*US%degC_to_C + CS%t_shelf(i,j) = CS%T_shelf_missing CS%tmask(i,j) = 0.0 endif elseif (ISS%hmask(i,j) == 0) then - CS%t_shelf(i,j) = -10.0*US%degC_to_C + CS%t_shelf(i,j) = CS%T_shelf_missing elseif ((ISS%hmask(i,j) == 3) .or. (ISS%hmask(i,j) == -2)) then CS%t_shelf(i,j) = CS%t_bdry_val(i,j) endif diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 618f0e66fe..e49fb03aaf 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -318,13 +318,10 @@ subroutine initialize_ice_shelf_boundary_channel(u_face_mask_bdry, v_face_mask_b real :: input_vel ! The input ice velocity per [L Z T-1 ~> m s-1] real :: lenlat, len_stress, westlon, lenlon, southlat ! The input positions of the channel boundarises - call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) - - call get_param(PF, mdl, "LENLON", lenlon, fail_if_missing=.true.) - - call get_param(PF, mdl, "WESTLON", westlon, fail_if_missing=.true.) - - call get_param(PF, mdl, "SOUTHLAT", southlat, fail_if_missing=.true.) + lenlat = G%len_lat + lenlon = G%len_lon + westlon = G%west_lon + southlat = G%south_lat call get_param(PF, mdl, "INPUT_VEL_ICE_SHELF", input_vel, & "inflow ice velocity at upstream boundary", & @@ -395,6 +392,8 @@ end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& G, US, PF) +!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,ice_visc,& +! G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: bed_elev !< The bed elevation [Z ~> m]. @@ -402,7 +401,6 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: v_shelf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. - real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. [nondim] @@ -450,14 +448,12 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& floatfr_varname = "float_frac" - !### I think that the following two lines should have ..., scale=US%m_s_to_L_T - call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, position=CORNER, scale=1.0) - call MOM_read_data(filename, trim(vshelf_varname), v_shelf, G%Domain, position=CORNER, scale=1.0) -! call MOM_read_data(filename, trim(ice_visc_varname), ice_visc, G%Domain,position=CORNER,scale=1.0) + call MOM_read_data(filename, trim(ushelf_varname), u_shelf, G%Domain, position=CORNER, scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(vshelf_varname), v_shelf, G%Domain, position=CORNER, scale=US%m_s_to_L_T) call MOM_read_data(filename, trim(floatfr_varname), float_cond, G%Domain, scale=1.) filename = trim(inputdir)//trim(bed_topo_file) - call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.) + call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.0) end subroutine initialize_ice_flow_from_file @@ -543,11 +539,12 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) - call MOM_read_data(filename, trim(ufcmskbdry_varname), u_face_mask_bdry, G%Domain, position=CORNER, scale=1.0) - call MOM_read_data(filename, trim(vfcmskbdry_varname), v_face_mask_bdry, G%Domain, position=CORNER, scale=1.0) - !### I think that the following two lines should have ..., scale=US%m_s_to_L_T - call MOM_read_data(filename, trim(ubdryv_varname), u_bdry_val, G%Domain, position=CORNER, scale=1.0) - call MOM_read_data(filename, trim(vbdryv_varname), v_bdry_val, G%Domain, position=CORNER, scale=1.) + call MOM_read_data(filename, trim(ufcmskbdry_varname), u_face_mask_bdry, G%Domain, position=CORNER, & + scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(vfcmskbdry_varname), v_face_mask_bdry, G%Domain, position=CORNER, & + scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(ubdryv_varname), u_bdry_val, G%Domain, position=CORNER, scale=US%m_s_to_L_T) + call MOM_read_data(filename, trim(vbdryv_varname), v_bdry_val, G%Domain, position=CORNER, scale=US%m_s_to_L_T) call MOM_read_data(filename, trim(umask_varname), umask, G%Domain, position=CORNER, scale=1.) call MOM_read_data(filename, trim(vmask_varname), vmask, G%Domain, position=CORNER, scale=1.) filename = trim(inputdir)//trim(icethick_file) @@ -615,16 +612,15 @@ subroutine initialize_ice_C_basal_friction(C_basal_friction, G, US, PF) end subroutine -!> Initialize ice basal friction +!> Initialize ice-stiffness parameter subroutine initialize_ice_AGlen(AGlen, G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: AGlen !< The ice-stiffness parameter A_Glen + intent(inout) :: AGlen !< The ice-stiffness parameter A_Glen, often in [Pa-3 s-1] type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters -! integer :: i, j - real :: A_Glen + real :: A_Glen ! Ice-stiffness parameter, often in [Pa-3 s-1] character(len=40) :: mdl = "initialize_ice_stiffness" ! This subroutine's name. character(len=200) :: config character(len=200) :: varname @@ -657,7 +653,7 @@ subroutine initialize_ice_AGlen(AGlen, G, US, PF) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_stiffness_from_file: Unable to open "//trim(filename)) - call MOM_read_data(filename,trim(varname),AGlen,G%Domain) + call MOM_read_data(filename,trim(varname), AGlen, G%Domain) endif end subroutine diff --git a/src/ice_shelf/MOM_marine_ice.F90 b/src/ice_shelf/MOM_marine_ice.F90 index f24f9b1881..8635eb71b5 100644 --- a/src/ice_shelf/MOM_marine_ice.F90 +++ b/src/ice_shelf/MOM_marine_ice.F90 @@ -28,7 +28,7 @@ module MOM_marine_ice type, public :: marine_ice_CS ; private real :: kv_iceberg !< The viscosity of the icebergs [L4 Z-2 T-1 ~> m2 s-1] (for ice rigidity) real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy - !! so that fluxes below are set to zero. (0.5 is a + !! so that fluxes below are set to zero [nondim]. (0.5 is a !! good value to use.) Not applied for negative values. real :: latent_heat_fusion !< Latent heat of fusion [Q ~> J kg-1] real :: density_iceberg !< A typical density of icebergs [R ~> kg m-3] (for ice rigidity) @@ -48,7 +48,7 @@ subroutine iceberg_forces(G, forces, use_ice_shelf, sfc_state, time_step, CS) type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: time_step !< The coupling time step [s]. + real, intent(in) :: time_step !< The coupling time step [T ~> s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice real :: kv_rho_ice ! The viscosity of ice divided by its density [L4 Z-2 T-1 R-1 ~> m5 kg-1 s-1]. @@ -106,7 +106,7 @@ subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, time_step, CS type(surface), intent(inout) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. logical, intent(in) :: use_ice_shelf !< If true, this configuration uses ice shelves. - real, intent(in) :: time_step !< The coupling time step [s]. + real, intent(in) :: time_step !< The coupling time step [T ~> s]. type(marine_ice_CS), pointer :: CS !< Pointer to the control structure for MOM_marine_ice real :: fraz ! refreezing rate [R Z T-1 ~> kg m-2 s-1] @@ -138,7 +138,7 @@ subroutine iceberg_fluxes(G, US, fluxes, use_ice_shelf, sfc_state, time_step, CS !Zero'ing out other fluxes under the tabular icebergs if (CS%berg_area_threshold >= 0.) then - I_dt_LHF = 1.0 / (US%s_to_T*time_step * CS%latent_heat_fusion) + I_dt_LHF = 1.0 / (time_step * CS%latent_heat_fusion) do j=jsd,jed ; do i=isd,ied if (fluxes%frac_shelf_h(i,j) > CS%berg_area_threshold) then ! Only applying for ice shelf covering most of cell. diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index c384ef7cee..4d1f263ca8 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -131,7 +131,9 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C logical, intent(in) :: new_sim !< If true, this the start of a new run. - real :: c1, edge_pos, slope_pos + real :: c1 ! The inverse of the range over which the shelf slopes [km-1] + real :: edge_pos ! The time-evolving position the ice shelf edge [km] + real :: slope_pos ! The time-evolving position of the start of the ice shelf slope [km] integer :: i, j edge_pos = CS%pos_shelf_edge_0 + CS%shelf_speed*(time_type_to_real(Time) / 86400.0) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 91b30a1e86..78f739c461 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -8,7 +8,8 @@ module MOM_coord_initialization 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, log_version -use MOM_io, only : close_file, create_file, file_type, fieldtype, file_exists +use MOM_io, only : create_MOM_file, file_exists +use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, MOM_write_field, vardesc, var_desc, SINGLE_FILE use MOM_string_functions, only : slasher, uppercase use MOM_unit_scaling, only : unit_scale_type @@ -261,6 +262,8 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s integer :: k, nz character(len=40) :: mdl = "set_coord_from_TS_profile" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path + character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files + nz = GV%ke call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") @@ -269,15 +272,21 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & - "The file from which the coordinate temperatures and "//& - "salinities are read.", fail_if_missing=.true.) + "The file from which the coordinate temperatures and salinities are read.", & + fail_if_missing=.true.) + call get_param(param_file, mdl, "TEMP_COORD_VAR", temp_var, & + "The coordinate reference profile variable name for potential temperature.", & + default="PTEMP") + call get_param(param_file, mdl, "SALT_COORD_VAR", salt_var, & + "The coordinate reference profile variable name for salinity.", & + default="SALT") call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") filename = trim(slasher(inputdir))//trim(coord_file) call log_param(param_file, mdl, "INPUTDIR/COORD_FILE", filename) - call MOM_read_data(filename, "PTEMP", T0(:), scale=US%degC_to_C) - call MOM_read_data(filename, "SALT", S0(:), scale=US%ppt_to_S) + call MOM_read_data(filename, temp_var, T0(:), scale=US%degC_to_C) + call MOM_read_data(filename, salt_var, S0(:), scale=US%ppt_to_S) if (.not.file_exists(filename)) call MOM_error(FATAL, & " set_coord_from_TS_profile: Unable to open " //trim(filename)) @@ -306,8 +315,8 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta real, dimension(GV%ke) :: T0 ! A profile of temperatures [C ~> degC] real, dimension(GV%ke) :: S0 ! A profile of salinities [S ~> ppt] real, dimension(GV%ke) :: Pref ! A array of reference pressures [R L2 T-2 ~> Pa] - real :: S_Ref ! Default salinity range parameters [ppt]. - real :: T_Ref ! Default temperature range parameters [degC]. + real :: S_Ref ! Default salinity range parameters [S ~> ppt]. + real :: T_Ref ! Default temperature range parameters [C ~> degC]. real :: S_Light, S_Dense ! Salinity range parameters [S ~> ppt]. real :: T_Light, T_Dense ! Temperature range parameters [C ~> degC]. real :: res_rat ! The ratio of density space resolution in the denser part @@ -324,22 +333,26 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") call get_param(param_file, mdl, "T_REF", T_Ref, & - "The default initial temperatures.", units="degC", default=10.0) + "The default initial temperatures.", & + units="degC", default=10.0, scale=US%degC_to_C) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_Light, & "The initial temperature of the lightest layer when "//& - "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref, scale=US%degC_to_C) + "COORD_CONFIG is set to ts_range.", & + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_Dense, & "The initial temperature of the densest layer when "//& - "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref, scale=US%degC_to_C) + "COORD_CONFIG is set to ts_range.", & + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C) call get_param(param_file, mdl, "S_REF", S_Ref, & - "The default initial salinities.", units="PSU", default=35.0) + "The default initial salinities.", & + units="PSU", default=35.0, scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_Light, & - "The initial lightest salinities when COORD_CONFIG "//& - "is set to ts_range.", default = S_Ref, units="PSU", scale=US%ppt_to_S) + "The initial lightest salinities when COORD_CONFIG is set to ts_range.", & + units="PSU", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_Dense, & - "The initial densest salinities when COORD_CONFIG "//& - "is set to ts_range.", default = S_Ref, units="PSU", scale=US%ppt_to_S) + "The initial densest salinities when COORD_CONFIG is set to ts_range.", & + units="PSU", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S) call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & "The ratio of density space resolution in the densest "//& @@ -357,7 +370,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta k_light = GV%nk_rho_varies + 1 - ! Set T0(k) to range from T_LIGHT to T_DENSE, and simliarly for S0(k). + ! Set T0(k) to range from T_LIGHT to T_DENSE, and similarly for S0(k). T0(k_light) = T_Light ; S0(k_light) = S_Light a1 = 2.0 * res_rat / (1.0 + res_rat) do k=k_light+1,nz @@ -458,7 +471,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m) - ! This following sets the target layer densities such that a the + ! This following sets the target layer densities such that the ! surface interface has density Rlay_ref and the bottom ! is Rlay_range larger do k=1,nz @@ -514,20 +527,21 @@ subroutine write_vertgrid_file(GV, US, param_file, directory) ! Local variables character(len=240) :: filepath type(vardesc) :: vars(2) - type(fieldtype) :: fields(2) - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_field) :: fields(2) + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset filepath = trim(directory) // trim("Vertical_coordinate") vars(1) = var_desc("R","kilogram meter-3","Target Potential Density",'1','L','1') vars(2) = var_desc("g","meter second-2","Reduced gravity",'1','L','1') - call create_file(IO_handle, trim(filepath), vars, 2, fields, SINGLE_FILE, GV=GV) + call create_MOM_file(IO_handle, trim(filepath), vars, 2, fields, & + SINGLE_FILE, GV=GV) call MOM_write_field(IO_handle, fields(1), GV%Rlay, scale=US%R_to_kg_m3) call MOM_write_field(IO_handle, fields(2), GV%g_prime, scale=US%L_T_to_m_s**2*US%m_to_Z) - call close_file(IO_handle) + call IO_handle%close() end subroutine write_vertgrid_file diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 88c6377abc..322abc6d5e 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -174,14 +174,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) end subroutine MOM_initialize_fixed -!> MOM_initialize_topography makes the appropriate call to set up the bathymetry. At this -!! point the topography is in units of [Z ~> m] or [m], depending on the presence of US. +!> MOM_initialize_topography makes the appropriate call to set up the bathymetry in units of [Z ~> m]. subroutine MOM_initialize_topography(D, max_depth, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [Z ~> m] or [m] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: PF !< Parameter file structure - real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] or [m] + real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. @@ -220,7 +219,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - max_depth = -1.e9*US%m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=US%m_to_Z) + call get_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, units="m", default=-1.e9, scale=US%m_to_Z, do_not_log=.true.) select case ( trim(config) ) case ("file"); call initialize_topography_from_file(D, G, PF, US) case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) @@ -245,12 +244,13 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*US%Z_to_m, & - "The maximum depth of the ocean.", units="m") + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, & + "The maximum depth of the ocean.", units="m", unscale=US%Z_to_m) else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*US%Z_to_m, & - "The (diagnosed) maximum depth of the ocean.", units="m", like_default=.true.) + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & + "The (diagnosed) maximum depth of the ocean.", & + units="m", unscale=US%Z_to_m, like_default=.true.) endif if (trim(config) /= "DOME") then call limit_topography(D, G, PF, max_depth, US) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index d84d2275e4..8bea8fe6e9 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -27,17 +27,17 @@ module MOM_grid_initialize !> Global positioning system (aka container for information to describe the grid) type, private :: GPS ; private - real :: len_lon !< The longitudinal or x-direction length of the domain. - real :: len_lat !< The latitudinal or y-direction length of the domain. + real :: len_lon !< The longitudinal or x-direction length of the domain [degrees_E] or [km] or [m]. + real :: len_lat !< The latitudinal or y-direction length of the domain [degrees_N] or [km] or [m]. real :: west_lon !< The western longitude of the domain or the equivalent - !! starting value for the x-axis. + !! starting value for the x-axis [degrees_E] or [km] or [m]. real :: south_lat !< The southern latitude of the domain or the equivalent - !! starting value for the y-axis. + !! starting value for the y-axis [degrees_N] or [km] or [m]. real :: Rad_Earth_L !< The radius of the Earth in rescaled units [L ~> m] real :: Lat_enhance_factor !< The amount by which the meridional resolution - !! is enhanced within LAT_EQ_ENHANCE of the equator. + !! is enhanced within LAT_EQ_ENHANCE of the equator [nondim] real :: Lat_eq_enhance !< The latitude range to the north and south of the equator - !! over which the resolution is enhanced, in degrees. + !! over which the resolution is enhanced [degrees_N] logical :: isotropic !< 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 @@ -83,6 +83,8 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" + G%x_ax_unit_short = "degrees_E" ; G%y_ax_unit_short = "degrees_N" + G%Rad_Earth_L = -1.0*US%m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 select case (trim(config)) case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) @@ -175,7 +177,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-2:2*G%jed+1) :: tmpU ! East face supergrid spacing [L ~> m] real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV ! North face supergrid spacing [L ~> m] real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ ! Corner latitudes or longitudes [degN] or [degE] - real, dimension(:,:), allocatable :: tmpGlbl ! A global array of axis labels + real, dimension(:,:), allocatable :: tmpGlbl ! A global array of axis labels [degrees_N] or [km] or [m] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -359,11 +361,11 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal - real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) - real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) + real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) ! Axis labels [degrees_N] or [km] or [m] + real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) ! Axis labels [degrees_E] or [km] or [m] real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -379,7 +381,10 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & "The units for the Cartesian axes. Valid entries are: \n"//& " \t degrees - degrees of latitude and longitude \n"//& - " \t m - meters \n \t k - kilometers", default="degrees") + " \t m or meter(s) - meters \n"//& + " \t k or km or kilometer(s) - kilometers", default="degrees") + if (trim(units_temp) == "k") units_temp = "km" + call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & "The southern latitude of the domain or the equivalent "//& "starting value for the y-axis.", units=units_temp, & @@ -399,8 +404,10 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" + G%x_ax_unit_short = "km" ; G%y_ax_unit_short = "km" elseif (units_temp(1:1) == 'm') then G%x_axis_units = "meters" ; G%y_axis_units = "meters" + G%x_ax_unit_short = "m" ; G%y_ax_unit_short = "m" endif call log_param(param_file, mdl, "explicit AXIS_UNITS", G%x_axis_units) @@ -491,13 +498,17 @@ subroutine set_grid_metrics_spherical(G, param_file, US) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) + real :: PI ! PI = 3.1415926... as 4*atan(1) [nondim] + real :: PI_180 ! The conversion factor from degrees to radians [radians degree-1] integer :: i, j, isd, ied, jsd, jed integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB integer :: i_offset, j_offset - real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) - real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) - real :: dLon, dLat, latitude, dL_di + real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) ! Axis labels [degrees_N] + real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) ! Axis labels [degrees_E] + real :: dLon ! The change in longitude between successive grid points [degrees_E] + real :: dLat ! The change in latitude between successive grid points [degrees_N] + real :: dL_di ! dLon rescaled from degrees to radians [radians] + real :: latitude ! The latitude of a grid point [degrees_N] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -510,19 +521,19 @@ subroutine set_grid_metrics_spherical(G, param_file, US) ! Calculate the values of the metric terms that might be used ! and save them in arrays. - PI = 4.0*atan(1.0); PI_180 = atan(1.0)/45. + PI = 4.0*atan(1.0) ; PI_180 = atan(1.0)/45. call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & - "The southern latitude of the domain.", units="degrees", & + "The southern latitude of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "LENLAT", G%len_lat, & - "The latitudinal length of the domain.", units="degrees", & + "The latitudinal length of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "WESTLON", G%west_lon, & - "The western longitude of the domain.", units="degrees", & + "The western longitude of the domain.", units="degrees_E", & default=0.0) call get_param(param_file, mdl, "LENLON", G%len_lon, & - "The longitudinal length of the domain.", units="degrees", & + "The longitudinal length of the domain.", units="degrees_E", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) @@ -632,19 +643,23 @@ subroutine set_grid_metrics_mercator(G, param_file, US) integer :: I_off, J_off type(GPS) :: GP character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_mercator" - real :: PI, PI_2! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0 - real :: y_q, y_h, jd, x_q, x_h, id + real :: PI, PI_2 ! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0 [nondim] + real :: y_q, y_h ! Latitudes of a point [radians] + real :: id ! The i-grid space positions whose longitude is being sought [gridpoints] + real :: jd ! The j-grid space positions whose latitude is being sought [gridpoints] + real :: x_q, x_h ! Longitudes of a point [radians] real, dimension(G%isd:G%ied,G%jsd:G%jed) :: & - xh, yh ! Latitude and longitude of h points in radians. + xh, yh ! Latitude and longitude of h points in radians [radians] real, dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: & - xu, yu ! Latitude and longitude of u points in radians. + xu, yu ! Latitude and longitude of u points in radians [radians] real, dimension(G%isd:G%ied,G%JsdB:G%JedB) :: & - xv, yv ! Latitude and longitude of v points in radians. + xv, yv ! Latitude and longitude of v points in radians [radians] real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & - xq, yq ! Latitude and longitude of q points in radians. + xq, yq ! Latitude and longitude of q points in radians [radians] real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is - real :: jRef, iRef ! being set to be at grid index jRef or iRef. + ! being set to be at grid index jRef or iRef [gridpoints] + real :: jRef, iRef ! The grid index at which fnRef is evaluated [gridpoints] integer :: itt1, itt2 logical, parameter :: simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -668,16 +683,16 @@ subroutine set_grid_metrics_mercator(G, param_file, US) PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI call get_param(param_file, mdl, "SOUTHLAT", GP%south_lat, & - "The southern latitude of the domain.", units="degrees", & + "The southern latitude of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "LENLAT", GP%len_lat, & - "The latitudinal length of the domain.", units="degrees", & + "The latitudinal length of the domain.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "WESTLON", GP%west_lon, & - "The western longitude of the domain.", units="degrees", & + "The western longitude of the domain.", units="degrees_E", & default=0.0) call get_param(param_file, mdl, "LENLON", GP%len_lon, & - "The longitudinal length of the domain.", units="degrees", & + "The longitudinal length of the domain.", units="degrees_E", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth_L, & "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) @@ -704,7 +719,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) units="nondim", default=1.0) call get_param(param_file, mdl, "LAT_EQ_ENHANCE", GP%Lat_eq_enhance, & "The latitude range to the north and south of the equator "//& - "over which the resolution is enhanced.", units="degrees", & + "over which the resolution is enhanced.", units="degrees_N", & default=0.0) ! With an isotropic grid, the north-south extent of the domain, @@ -853,8 +868,8 @@ end subroutine set_grid_metrics_mercator !> This function returns the grid spacing in the logical x direction in [L ~> m]. function ds_di(x, y, GP) - real, intent(in) :: x !< The longitude in question - real, intent(in) :: y !< The latitude in question + real, intent(in) :: x !< The longitude in question [radians] + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_di ! The returned grid spacing [L ~> m] @@ -867,8 +882,8 @@ end function ds_di !> This function returns the grid spacing in the logical y direction in [L ~> m]. function ds_dj(x, y, GP) - real, intent(in) :: x !< The longitude in question - real, intent(in) :: y !< The latitude in question + real, intent(in) :: x !< The longitude in question [radians] + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters real :: ds_dj ! The returned grid spacing [L ~> m] @@ -880,16 +895,17 @@ function ds_dj(x, y, GP) end function ds_dj !> This function returns the contribution from the line integral along one of the four sides of a -!! cell face to the area of a cell, assuming that the sides follow a linear path in latitude and -!! longitude (i.e., on a Mercator grid). +!! cell face to the area of a cell, in [radians2], assuming that the sides follow a linear path in +!! latitude and longitude (i.e., on a Mercator grid). function dL(x1, x2, y1, y2) - real, intent(in) :: x1 !< Segment starting longitude, in degrees E. - real, intent(in) :: x2 !< Segment ending longitude, in degrees E. - real, intent(in) :: y1 !< Segment ending latitude, in degrees N. - real, intent(in) :: y2 !< Segment ending latitude, in degrees N. + real, intent(in) :: x1 !< Segment starting longitude [radians] + real, intent(in) :: x2 !< Segment ending longitude [radians] + real, intent(in) :: y1 !< Segment starting latitude [radians] + real, intent(in) :: y2 !< Segment ending latitude [radians] ! Local variables - real :: dL - real :: r, dy + real :: dL ! A contribution to the spanned area the surface of the sphere [radian2] + real :: r ! A contribution from the range of latitudes, including trigonometric factors [radians] + real :: dy ! The spanned range of latitudes [radians] dy = y2 - y1 @@ -906,23 +922,25 @@ end function dL !! function fn takes the value fnval, also returning in ittmax the number of iterations of !! Newton's method that were used to polish the root. function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) - real :: find_root !< The value of y where fn(y) = fnval that will be returned - real, external :: fn !< The external function whose root is being sought - real, external :: dy_df !< The inverse of the derivative of that function - type(GPS), intent(in) :: GP !< A structure of grid parameters - real, intent(in) :: fnval !< The value of fn being sought - real, intent(in) :: y1 !< A first guess for y - real, intent(in) :: ymin !< The minimum permitted value of y - real, intent(in) :: ymax !< The maximum permitted value of y + real :: find_root !< The value of y where fn(y) = fnval that will be returned [radians] + real, external :: fn !< The external function whose root is being sought [gridpoints] + real, external :: dy_df !< The inverse of the derivative of that function [radian gridpoint-1] + type(GPS), intent(in) :: GP !< A structure of grid parameters + real, intent(in) :: fnval !< The value of fn being sought [gridpoints] + real, intent(in) :: y1 !< A first guess for y [radians] + real, intent(in) :: ymin !< The minimum permitted value of y [radians] + real, intent(in) :: ymax !< The maximum permitted value of y [radians] integer, intent(out) :: ittmax !< The number of iterations used to polish the root ! Local variables - real :: y, y_next - real :: ybot, ytop, fnbot, fntop + real :: y, y_next ! Successive guesses at the root position [radians] + real :: ybot, ytop ! Brackets bounding the root [radians] + real :: fnbot, fntop ! Values of fn at the bounding values of y [gridpoints] + real :: dy_dfn ! The inverse of the local derivative of fn with y [radian gridpoint-1] + real :: dy ! The jump to the next guess of y [radians] + real :: fny ! The difference between fn(y) and the target value [gridpoints] integer :: itt character(len=256) :: warnmesg - real :: dy_dfn, dy, fny - ! Bracket the root. Do not use the bounding values because the value at the ! function at the bounds could be infinite, as is the case for the Mercator ! grid recursion relation. (I.e., this is a search on an open interval.) @@ -1015,40 +1033,40 @@ function find_root( fn, dy_df, GP, fnval, y1, ymin, ymax, ittmax) find_root = y end function find_root -!> This function calculates and returns the value of dx/di, where x is the -!! longitude in Radians, and i is the integral north-south grid index. +!> This function calculates and returns the value of dx/di in [radian gridpoint-1], +!! where x is the longitude in Radians, and i is the integral east-west grid index. function dx_di(x, GP) - real, intent(in) :: x !< The longitude in question + real, intent(in) :: x !< The longitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: dx_di + real :: dx_di ! The derivative of zonal position with the grid index [radian gridpoint-1] dx_di = (GP%len_lon * 4.0*atan(1.0)) / (180.0 * GP%niglobal) end function dx_di !> This function calculates and returns the integral of the inverse -!! of dx/di to the point x, in radians. +!! of dx/di to the point x, in radians [gridpoints] function Int_di_dx(x, GP) - real, intent(in) :: x !< The longitude in question + real, intent(in) :: x !< The longitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: Int_di_dx + real :: Int_di_dx ! A position in the global i-index space [gridpoints] Int_di_dx = x * ((180.0 * GP%niglobal) / (GP%len_lon * 4.0*atan(1.0))) end function Int_di_dx -!> This subroutine calculates and returns the value of dy/dj, where y is the -!! latitude in Radians, and j is the integral north-south grid index. +!> This subroutine calculates and returns the value of dy/dj in [radian gridpoint-1], +!! where y is the latitude in Radians, and j is the integral north-south grid index. function dy_dj(y, GP) - real, intent(in) :: y !< The latitude in question + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: dy_dj + real :: dy_dj ! The derivative of meridional position with the grid index [radian gridpoint-1] ! Local variables - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: C0 ! The constant that converts the nominal y-spacing in - ! gridpoints to the nominal spacing in Radians. + ! gridpoints to the nominal spacing in Radians [radian gridpoint-1] real :: y_eq_enhance ! The latitude in radians within which the resolution - ! is enhanced. + ! is enhanced [radians] PI = 4.0*atan(1.0) if (GP%isotropic) then C0 = (GP%len_lon * PI) / (180.0 * GP%niglobal) @@ -1067,21 +1085,19 @@ function dy_dj(y, GP) end function dy_dj !> This subroutine calculates and returns the integral of the inverse -!! of dy/dj to the point y, in radians. +!! of dy/dj to the point y in radians [gridpoints] function Int_dj_dy(y, GP) - real, intent(in) :: y !< The latitude in question + real, intent(in) :: y !< The latitude in question [radians] type(GPS), intent(in) :: GP !< A structure of grid parameters - real :: Int_dj_dy + real :: Int_dj_dy ! The grid position of latitude y [gridpoints] ! Local variables - real :: I_C0 = 0.0 ! The inverse of the constant that converts the + real :: I_C0 ! The inverse of the constant that converts the ! nominal spacing in gridpoints to the nominal - ! spacing in Radians. - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: y_eq_enhance ! The latitude in radians from - ! from the equator within which the - ! meridional grid spacing is enhanced by - ! a factor of GP%lat_enhance_factor. - real :: r + ! spacing in Radians [gridpoint radian-1] + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] + real :: y_eq_enhance ! The latitude in radians from from the equator within which the meridional + ! grid spacing is enhanced by a factor of GP%lat_enhance_factor [radians] + real :: r ! The y grid position in the global index space [gridpoints] PI = 4.0*atan(1.0) if (GP%isotropic) then @@ -1112,12 +1128,12 @@ end function Int_dj_dy !> Extrapolates missing metric data into all the halo regions. subroutine extrapolate_metric(var, jh, missing) - real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos + real, dimension(:,:), intent(inout) :: var !< The array in which to fill in halos [abitrary] integer, intent(in) :: jh !< The size of the halos to be filled - real, optional, intent(in) :: missing !< The missing data fill value, 0 by default. + real, optional, intent(in) :: missing !< The missing data fill value, 0 by default [abitrary] ! Local variables - real :: badval - integer :: i,j + real :: badval ! A bad data value [abitrary] + integer :: i, j badval = 0.0 ; if (present(missing)) badval = missing @@ -1146,8 +1162,8 @@ end subroutine extrapolate_metric !> This function implements Adcroft's rule for reciprocals, namely that !! Adcroft_Inv(x) = 1/x for |x|>0 or 0 for x=0. function Adcroft_reciprocal(val) result(I_val) - real, intent(in) :: val !< The value being inverted. - real :: I_val !< The Adcroft reciprocal of val. + real, intent(in) :: val !< The value being inverted [abitrary] + real :: I_val !< The Adcroft reciprocal of val [abitrary-1] I_val = 0.0 if (val /= 0.0) I_val = 1.0/val diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index ff272e7fce..46d0448699 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -11,7 +11,8 @@ module MOM_shared_initialization 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, log_param, param_file_type, log_version -use MOM_io, only : close_file, create_file, file_type, fieldtype, file_exists, field_size +use MOM_io, only : create_MOM_file, file_exists, field_size +use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, MOM_read_vector, read_variable, stdout use MOM_io, only : open_file_to_read, close_file_to_read, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, MOM_write_field, var_desc @@ -95,11 +96,13 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) intent(out) :: dF_dy !< y-component of grad f [T-1 L-1 ~> s-1 m-1] type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables + character(len=40) :: mdl = "MOM_calculate_grad_Coriolis" ! This subroutine's name. integer :: i,j - real :: f1, f2 + real :: f1, f2 ! Average of adjacent Coriolis parameters [T-1 ~> s-1] + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & - (LBOUND(G%CoriolisBu,2) > G%isc-1)) then + (LBOUND(G%CoriolisBu,2) > G%jsc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. dF_dx(:,:) = 0.0 ; dF_dy(:,:) = 0.0 return @@ -114,6 +117,7 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) dF_dy(i,j) = G%IdyT(i,j) * ( f1 - f2 ) enddo ; enddo call pass_vector(dF_dx, dF_dy, G%Domain, stagger=AGRID) + call callTree_leave(trim(mdl)//'()') end subroutine MOM_calculate_grad_Coriolis @@ -121,8 +125,8 @@ end subroutine MOM_calculate_grad_Coriolis function diagnoseMaximumDepth(D, G) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: D !< Ocean bottom depth in m or Z - real :: diagnoseMaximumDepth !< The global maximum ocean bottom depth in m or Z + intent(in) :: D !< Ocean bottom depth in [m] or [Z ~> m] + real :: diagnoseMaximumDepth !< The global maximum ocean bottom depth in [m] or [Z ~> m] ! Local variables integer :: i,j diagnoseMaximumDepth = D(G%isc,G%jsc) @@ -292,7 +296,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! Local variables real :: min_depth ! The minimum depth [Z ~> m]. - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] real :: expdecay ! A decay scale of associated with the sloping boundaries [L ~> m] real :: Dedge ! The depth at the basin edge [Z ~> m] @@ -323,12 +327,12 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth PI = 4.0*atan(1.0) if (trim(topog_config) == "flat") then - do i=is,ie ; do j=js,je ; D(i,j) = max_depth ; enddo ; enddo + do j=js,je ; do i=is,ie ; D(i,j) = max_depth ; enddo ; enddo elseif (trim(topog_config) == "spoon") then D0 = (max_depth - Dedge) / & ((1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay))) * & (1.0 - exp(-0.5*G%len_lat*G%Rad_Earth_L*PI/(180.0 *expdecay)))) - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie ! This sets a bowl shaped (sort of) bottom topography, with a ! ! maximum depth of max_depth. ! D(i,j) = Dedge + D0 * & @@ -343,7 +347,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth ! This sets a bowl shaped (sort of) bottom topography, with a ! maximum depth of max_depth. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie D(i,j) = Dedge + D0 * & (sin(PI * (G%geoLonT(i,j) - G%west_lon) / G%len_lon) * & ((1.0 - exp(-(G%geoLatT(i,j) - G%south_lat)*G%Rad_Earth_L*PI/ & @@ -353,7 +357,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth enddo ; enddo elseif (trim(topog_config) == "halfpipe") then D0 = max_depth - Dedge - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie D(i,j) = Dedge + D0 * ABS(sin(PI*(G%geoLatT(i,j) - G%south_lat)/G%len_lat)) enddo ; enddo else @@ -362,7 +366,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth endif ! This is here just for safety. Hopefully it doesn't do anything. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie if (D(i,j) > max_depth) D(i,j) = max_depth if (D(i,j) < min_depth) D(i,j) = 0.5*min_depth enddo ; enddo @@ -449,7 +453,7 @@ subroutine set_rotation_planetary(f, G, param_file, US) ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] real :: omega ! The planetary rotation rate [T-1 ~> s-1] call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") @@ -480,10 +484,10 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) integer :: I, J real :: f_0 ! The reference value of the Coriolis parameter [T-1 ~> s-1] real :: beta ! The meridional gradient of the Coriolis parameter [T-1 L-1 ~> s-1 m-1] - real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] + real :: beta_lat_ref ! The reference latitude for the beta plane [degrees_N] or [km] or [m] real :: Rad_Earth_L ! The radius of the planet in rescaled units [L ~> m] real :: y_scl ! A scaling factor from the units of latitude [L lat-1 ~> m lat-1] - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units character(len=40) :: beta_lat_ref_units @@ -533,10 +537,12 @@ subroutine initialize_grid_rotation_angle(G, PF) type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. - real :: angle, lon_scale - real :: len_lon ! The periodic range of longitudes, usually 360 degrees. - real :: pi_720deg ! One quarter the conversion factor from degrees to radians. - real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value. + real :: angle ! The clockwise angle of the grid relative to true north [degrees] + real :: lon_scale ! The trigonometric scaling factor converting changes in longitude + ! to equivalent distances in latitudes [nondim] + real :: len_lon ! The periodic range of longitudes, usually 360 degrees [degrees_E]. + real :: pi_720deg ! One quarter the conversion factor from degrees to radians [radian degree-1] + real :: lonB(2,2) ! The longitude of a point, shifted to have about the same value [degrees_E]. character(len=40) :: mdl = "initialize_grid_rotation_angle" ! This subroutine's name. logical :: use_bugs integer :: i, j, m, n @@ -587,10 +593,10 @@ end subroutine initialize_grid_rotation_angle !> Return the modulo value of x in an interval [xc-(Lx/2) xc+(Lx/2)] !! If Lx<=0, then it returns x without applying modulo arithmetic. function modulo_around_point(x, xc, Lx) result(x_mod) - real, intent(in) :: x !< Value to which to apply modulo arithmetic - real, intent(in) :: xc !< Center of modulo range - real, intent(in) :: Lx !< Modulo range width - real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc. + real, intent(in) :: x !< Value to which to apply modulo arithmetic [A] + real, intent(in) :: xc !< Center of modulo range [A] + real, intent(in) :: Lx !< Modulo range width [A] + real :: x_mod !< x shifted by an integer multiple of Lx to be close to xc [A]. if (Lx > 0.0) then x_mod = modulo(x - (xc - 0.5*Lx), Lx) + (xc - 0.5*Lx) @@ -611,9 +617,9 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! Local variables character(len=256) :: mesg ! Message for error messages. - real :: dx_2 ! Half the local zonal grid spacing [degreesE] - real :: dy_2 ! Half the local meridional grid spacing [degreesN] - real :: pi_180 + real :: dx_2 ! Half the local zonal grid spacing [degrees_E] + real :: dy_2 ! Half the local meridional grid spacing [degrees_N] + real :: pi_180 ! Conversion factor from degrees to radians [nondim] integer :: option integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -738,7 +744,9 @@ subroutine reset_face_lengths_file(G, param_file, US) character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path + character(len=64) :: dxCv_open_var, dyCu_open_var ! Open face length names in files integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. @@ -758,7 +766,14 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) + call get_param(param_file, mdl, "OPEN_DY_CU_VAR", dyCu_open_var, & + "The u-face open face length variable in CHANNEL_WIDTH_FILE.", & + default="dyCuo") + call get_param(param_file, mdl, "OPEN_DX_CV_VAR", dxCv_open_var, & + "The v-face open face length variable in CHANNEL_WIDTH_FILE.", & + default="dxCvo") + + call MOM_read_vector(filename, dyCu_open_var, dxCv_open_var, G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB @@ -806,20 +821,20 @@ subroutine reset_face_lengths_list(G, param_file, US) character(len=200) :: filename, chan_file, inputdir ! Strings for file/path character(len=40) :: mdl = "reset_face_lengths_list" ! This subroutine's name. real, allocatable, dimension(:,:) :: & - u_lat, u_lon, v_lat, v_lon ! The latitude and longitude ranges of faces [degrees] + u_lat, u_lon, v_lat, v_lon ! The latitude and longitude ranges of faces [degrees_N] or [degrees_E] real, allocatable, dimension(:) :: & - u_width, v_width ! The open width of faces [m] + u_width, v_width ! The open width of faces [L ~> m] integer, allocatable, dimension(:) :: & u_line_no, v_line_no, & ! The line numbers in lines of u- and v-face lines u_line_used, v_line_used ! The number of times each u- and v-line is used. real, allocatable, dimension(:) :: & - Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] + Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [Z ~> m] real, allocatable, dimension(:) :: & - Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [m] - real :: lat, lon ! The latitude and longitude of a point. - real :: len_lon ! The periodic range of longitudes, usually 360 degrees. - real :: len_lat ! The range of latitudes, usually 180 degrees. - real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees. + Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [Z ~> m] + real :: lat, lon ! The latitude and longitude of a point [degrees_N] and [degrees_E]. + real :: len_lon ! The periodic range of longitudes, usually 360 degrees [degrees_E]. + real :: len_lat ! The range of latitudes, usually 180 degrees [degrees_N]. + real :: lon_p, lon_m ! The longitude of a point shifted by 360 degrees [degrees_E]. logical :: check_360 ! If true, check for longitudes that are shifted by ! +/- 360 degrees from the specified range of values. logical :: found_u, found_v @@ -934,6 +949,10 @@ subroutine reset_face_lengths_list(G, param_file, US) read(line(isu_por+12:),*) u_lon(1:2,u_pt), u_lat(1:2,u_pt), u_width(u_pt), & Dmin_u(u_pt), Dmax_u(u_pt), Davg_u(u_pt) endif + u_width(u_pt) = US%m_to_L*u_width(u_pt) ! Rescale units equivalently to scale=US%m_to_L during read. + Dmin_u(u_pt) = US%m_to_Z*Dmin_u(u_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Dmax_u(u_pt) = US%m_to_Z*Dmax_u(u_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Davg_u(u_pt) = US%m_to_Z*Davg_u(u_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. u_line_no(u_pt) = ln if (is_root_PE()) then if (check_360) then @@ -971,6 +990,10 @@ subroutine reset_face_lengths_list(G, param_file, US) read(line(isv+12:),*) v_lon(1:2,v_pt), v_lat(1:2,v_pt), v_width(v_pt), & Dmin_v(v_pt), Dmax_v(v_pt), Davg_v(v_pt) endif + v_width(v_pt) = US%m_to_L*v_width(v_pt) ! Rescale units equivalently to scale=US%m_to_L during read. + Dmin_v(v_pt) = US%m_to_Z*Dmin_v(v_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Dmax_v(v_pt) = US%m_to_Z*Dmax_v(v_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. + Davg_v(v_pt) = US%m_to_Z*Davg_v(v_pt) ! Rescale units equivalently to scale=US%m_to_Z during read. v_line_no(v_pt) = ln if (is_root_PE()) then if (check_360) then @@ -1016,10 +1039,10 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(US%m_to_L*u_width(npt), 0.0)) - G%porous_DminU(I,j) = US%m_to_Z*Dmin_u(npt) - G%porous_DmaxU(I,j) = US%m_to_Z*Dmax_u(npt) - G%porous_DavgU(I,j) = US%m_to_Z*Davg_u(npt) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(u_width(npt), 0.0)) + G%porous_DminU(I,j) = Dmin_u(npt) + G%porous_DmaxU(I,j) = Dmax_u(npt) + G%porous_DavgU(I,j) = Davg_u(npt) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then @@ -1053,10 +1076,10 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(US%m_to_L*v_width(npt), 0.0)) - G%porous_DminV(i,J) = US%m_to_Z*Dmin_v(npt) - G%porous_DmaxV(i,J) = US%m_to_Z*Dmax_v(npt) - G%porous_DavgV(i,J) = US%m_to_Z*Davg_v(npt) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(v_width(npt), 0.0)) + G%porous_DminV(i,J) = Dmin_v(npt) + G%porous_DmaxV(i,J) = Dmax_v(npt) + G%porous_DavgV(i,J) = Davg_v(npt) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then @@ -1290,7 +1313,7 @@ subroutine compute_global_grid_integrals(G, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming ! Masked and unscaled cell areas [m2] real :: area_scale ! A scaling factor for area into MKS units [m2 L-2 ~> 1] integer :: i,j @@ -1327,9 +1350,9 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) character(len=40) :: mdl = "write_ocean_geometry_file" type(vardesc), dimension(:), allocatable :: & vars ! Types with metadata about the variables and their staggering - type(fieldtype), dimension(:), allocatable :: & + type(MOM_field), dimension(:), allocatable :: & fields ! Opaque types used by MOM_io to store variable metadata information - type(file_type) :: IO_handle ! The I/O handle of the fileset + type(MOM_infra_file) :: IO_handle ! The I/O handle of the fileset integer :: nFlds ! The number of variables in this file integer :: file_threading logical :: multiple_files @@ -1393,7 +1416,8 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) file_threading = SINGLE_FILE if (multiple_files) file_threading = MULTIPLE - call create_file(IO_handle, trim(filepath), vars, nFlds, fields, file_threading, dG=G) + call create_MOM_file(IO_handle, trim(filepath), vars, nFlds, fields, & + file_threading, dG=G) call MOM_write_field(IO_handle, fields(1), G%Domain, G%geoLatBu) call MOM_write_field(IO_handle, fields(2), G%Domain, G%geoLonBu) @@ -1426,7 +1450,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=US%Z_to_m) endif - call close_file(IO_handle) + call IO_handle%close() deallocate(vars, fields) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 31dbb41dcc..bd0931c694 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -92,7 +92,7 @@ module MOM_state_initialization use MOM_regridding, only : regridding_CS, set_regrid_params, getCoordinateResolution use MOM_regridding, only : regridding_main, regridding_preadjust_reqs, convective_adjustment use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h -use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer +use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer, homogenize_field use MOM_oda_incupd, only: oda_incupd_CS, initialize_oda_incupd_fixed, initialize_oda_incupd use MOM_oda_incupd, only: set_up_oda_incupd_field, set_up_oda_incupd_vel_field use MOM_oda_incupd, only: calc_oda_increments, output_oda_incupd_inc @@ -135,7 +135,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & !! for model parameter values. type(directories), intent(in) :: dirs !< A structure containing several relevant !! directory paths. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure type(ALE_CS), pointer :: ALE_CSp !< The ALE control structure for remapping type(tracer_registry_type), pointer :: tracer_Reg !< A pointer to the tracer registry type(sponge_CS), pointer :: sponge_CSp !< The layerwise sponge control structure. @@ -154,9 +154,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. + ! a restart file to the internal representation in this run [various units ~> 1] real :: vel_rescale ! A rescaling factor for velocities from the representation in - ! a restart file to the internal representation in this run. + ! a restart file to the internal representation in this run [various units ~> 1] real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. logical :: from_Z_file, useALE @@ -342,7 +342,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! Initialize temperature and salinity (T and S). if ( use_temperature ) then call get_param(PF, mdl, "TS_CONFIG", config, & - "A string that determines how the initial tempertures "//& + "A string that determines how the initial temperatures "//& "and salinities are specified for a new run: \n"//& " \t file - read velocities from the file specified \n"//& " \t\t by (TS_FILE). \n"//& @@ -471,7 +471,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "file is read.", default=.not.GV%Boussinesq, do_not_log=just_read) if (new_sim .and. convert .and. .not.GV%Boussinesq) & - ! Convert thicknesses from geomtric distances to mass-per-unit-area. + ! Convert thicknesses from geometric distances to mass-per-unit-area. call convert_thickness(h, G, GV, US, tv) ! Remove the mass that would be displaced by an ice shelf or inverse barometer. @@ -496,7 +496,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & "an initial grid that is consistent with the initial conditions.", & default=1, do_not_log=just_read) - call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true., scale=US%s_to_T) + call get_param(PF, mdl, "DT", dt, "Timestep", & + units="s", scale=US%s_to_T, fail_if_missing=.true.) if (new_sim .and. debug) & call hchksum(h, "Pre-ALE_regrid: h ", G%HI, haloshift=1, scale=GV%H_to_m) @@ -684,12 +685,20 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f ! Local variables real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. - integer :: inconsistent = 0 + real :: h_rescale ! A factor by which to rescale the initial thickness variable in the input + ! file to convert it to units of m [various] + real :: eta_rescale ! A factor by which to rescale the initial interface heights to convert + ! them to units of m or correct sign conventions to positive upward [various] + real :: h_tolerance ! A parameter that controls the tolerance when adjusting the + ! thickness to fit the bathymetry [Z ~> m]. + real :: tol_dz_bot ! A tolerance for detecting inconsistent bottom depths when + ! correct_thickness is false [Z ~> m] + integer :: inconsistent ! The total number of cells with in consistent topography and layer thicknesses. logical :: correct_thickness - real :: h_tolerance ! A parameter that controls the tolerance when adjusting the - ! thickness to fit the bathymetry [Z ~> m]. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path + character(len=80) :: eta_var ! The interface height variable name in the input file + character(len=80) :: h_var ! The thickness variable name in the input file integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -710,9 +719,16 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f " initialize_thickness_from_file: Unable to open "//trim(filename)) if (file_has_thickness) then - !### Consider adding a parameter to use to rescale h. + call get_param(param_file, mdl, "THICKNESS_IC_VAR", h_var, & + "The variable name for layer thickness initial conditions.", & + default="h", do_not_log=just_read) + call get_param(param_file, mdl, "THICKNESS_IC_RESCALE", h_rescale, & + "A factor by which to rescale the initial thicknesses in the input "//& + "file to convert them to units of m.", & + default=1.0, units="various", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "h", h(:,:,:), G%Domain, scale=GV%m_to_H) + + call MOM_read_data(filename, h_var, h(:,:,:), G%Domain, scale=h_rescale*GV%m_to_H) else call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the "//& @@ -724,9 +740,22 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) endif + call get_param(param_file, mdl, "DZ_BOTTOM_TOLERANCE", tol_dz_bot, & + "A tolerance for detecting inconsistent topography and input layer "//& + "thicknesses when ADJUST_THICKNESS is false.", & + units="m", default=1.0, scale=US%m_to_Z, & + do_not_log=(just_read.or.correct_thickness)) + call get_param(param_file, mdl, "INTERFACE_IC_VAR", eta_var, & + "The variable name for initial conditions for interface heights "//& + "relative to mean sea level, positive upward unless otherwise rescaled.", & + default="eta", do_not_log=just_read) + call get_param(param_file, mdl, "INTERFACE_IC_RESCALE", eta_rescale, & + "A factor by which to rescale the initial interface heights to convert "//& + "them to units of m or correct sign conventions to positive upward.", & + default=1.0, units="various", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=US%m_to_Z) + call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z*eta_rescale) if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, US, eta, h, h_tolerance, dZ_ref_eta=G%Z_ref) @@ -740,8 +769,9 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f endif enddo ; enddo ; enddo + inconsistent = 0 do j=js,je ; do i=is,ie - if (abs(eta(i,j,nz+1) + depth_tot(i,j)) > 1.0*US%m_to_Z) & + if (abs(eta(i,j,nz+1) + depth_tot(i,j)) > tol_dz_bot) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -855,10 +885,10 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re !! parameters without changing h. ! Local variables character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. - real :: e0(SZK_(GV)+1) ! The resting interface heights, in depth units, usually + real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], usually ! negative because it is positive upward. - real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units. + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface, + ! positive upward [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -868,7 +898,7 @@ subroutine initialize_thickness_uniform(h, depth_tot, G, GV, param_file, just_re call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (G%max_depth<=0.) call MOM_error(FATAL,"initialize_thickness_uniform: "// & - "MAXIMUM_DEPTH has a non-sensical value! Was it set?") + "MAXIMUM_DEPTH has a nonsensical value! Was it set?") do k=1,nz e0(K) = -G%max_depth * real(k-1) / real(nz) @@ -915,7 +945,7 @@ subroutine initialize_thickness_list(h, depth_tot, G, GV, US, param_file, just_r real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path - character(len=72) :: eta_var + character(len=72) :: eta_var ! The interface height variable name in the input file integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1069,8 +1099,8 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read, z_top_shelf) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & eta ! The free surface height that the model should use [Z ~> m]. real :: dilate ! A ratio by which layers are dilated [nondim]. - real :: scale_factor ! A scaling factor for the eta_sfc values that are read - ! in, which can be used to change units, for example. + real :: scale_factor ! A scaling factor for the eta_sfc values that are read in, + ! which can be used to change units, for example, often [Z m-1 ~> 1]. character(len=40) :: mdl = "depress_surface" ! This subroutine's name. character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path @@ -1162,10 +1192,11 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S_t, S_b ! Top and bottom edge values for reconstructions ! of salinity within each layer [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T_t, T_b ! Top and bottom edge values for reconstructions - ! of temperature within each layer [T ~> degC] + ! of temperature within each layer [C ~> degC] character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path - real :: scale_factor ! A file-dependent scaling factor for the input pressure. + real :: scale_factor ! A file-dependent scaling factor for the input pressure [various]. real :: min_thickness ! The minimum layer thickness, recast into Z units [Z ~> m]. + real :: z_tolerance ! The tolerance with which to find the depth matching a specified pressure [Z ~> m]. integer :: i, j, k integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -1195,6 +1226,11 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) units="file dependent", default=1., do_not_log=just_read) call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & units='m', default=1.e-3, scale=US%m_to_Z, do_not_log=just_read) + call get_param(PF, mdl, "TRIM_IC_Z_TOLERANCE", z_tolerance, & + "The tolerance with which to find the depth matching the specified "//& + "surface pressure with TRIM_IC_FOR_P_SURF.", & + units="m", default=1.0e-5, scale=US%m_to_Z, do_not_log=just_read) + call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & default=.false., do_not_log=just_read) @@ -1248,7 +1284,7 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) 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_answer_date=remap_answer_date) + z_tol=z_tolerance, remap_answer_date=remap_answer_date) enddo ; enddo end subroutine trim_for_ice @@ -1269,7 +1305,7 @@ subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & eta ! The free surface height that the model should use [Z ~> m]. ! temporary arrays - real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice + real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice [R ~> kg m-3] real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2] real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] @@ -1357,7 +1393,7 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, real, dimension(nk), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(remapping_CS), pointer :: remap_CS !< Remapping structure for remapping T and S, !! if associated - real, optional, intent(in) :: z_tol !< The tolerance with which to find the depth + real, intent(in) :: z_tol !< The tolerance with which to find the depth !! matching the specified pressure [Z ~> m]. integer, optional, intent(in) :: remap_answer_date !< The vintage of the order of arithmetic and !! expressions to use for remapping. Values below 20190101 @@ -1365,10 +1401,12 @@ subroutine cut_off_column_top(nk, tv, GV, US, G_earth, depth, min_thickness, T, !! values use more robust forms of the same remapping expressions. ! Local variables - real, dimension(nk+1) :: e ! Top and bottom edge values for reconstructions [Z ~> m] - real, dimension(nk) :: h0, S0, T0, h1, S1, T1 + real, dimension(nk+1) :: e ! Top and bottom edge positions for reconstructions [Z ~> m] + real, dimension(nk) :: h0, h1 ! Initial and remapped layer thicknesses [H ~> m or kg m-2] + real, dimension(nk) :: S0, S1 ! Initial and remapped layer salinities [S ~> ppt] + real, dimension(nk) :: T0, T1 ! Initial and remapped layer temperatures [C ~> degC] real :: P_t, P_b ! Top and bottom pressures [R L2 T-2 ~> Pa] - real :: z_out, e_top + real :: z_out, e_top ! Interface height positions [Z ~> m] logical :: answers_2018 integer :: k @@ -1452,7 +1490,8 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read) !! parameters without changing u or v. ! Local variables character(len=40) :: mdl = "initialize_velocity_from_file" ! This subroutine's name. - character(len=200) :: filename,velocity_file,inputdir ! Strings for file/path + character(len=200) :: filename, velocity_file, inputdir ! Strings for file/path + character(len=64) :: u_IC_var, v_IC_var ! Velocity component names in files if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") @@ -1462,16 +1501,23 @@ subroutine initialize_velocity_from_file(u, v, G, GV, US, param_file, just_read) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - if (just_read) return ! All run-time parameters have been read, so return. - filename = trim(inputdir)//trim(velocity_file) - call log_param(param_file, mdl, "INPUTDIR/VELOCITY_FILE", filename) + if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/VELOCITY_FILE", filename) + + call get_param(param_file, mdl, "U_IC_VAR", u_IC_var, & + "The initial condition variable for zonal velocity in VELOCITY_FILE.", & + default="u") + call get_param(param_file, mdl, "V_IC_VAR", v_IC_var, & + "The initial condition variable for meridional velocity in VELOCITY_FILE.", & + default="v") + + if (just_read) return ! All run-time parameters have been read, so return. if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_velocity_from_file: Unable to open "//trim(filename)) ! Read the velocities from a netcdf file. - call MOM_read_vector(filename, "u", "v", u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) + call MOM_read_vector(filename, u_IC_var, v_IC_var, u(:,:,:), v(:,:,:), G%Domain, scale=US%m_s_to_L_T) call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file @@ -1524,7 +1570,7 @@ subroutine initialize_velocity_uniform(u, v, G, GV, US, param_file, just_read) !! parameters without changing u or v. ! Local variables integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real :: initial_u_const, initial_v_const + real :: initial_u_const, initial_v_const ! Constant initial velocities [L T-1 ~> m s-1] character(len=200) :: mdl = "initialize_velocity_uniform" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1565,7 +1611,7 @@ subroutine initialize_velocity_circular(u, v, G, GV, US, param_file, just_read) ! Local variables character(len=200) :: mdl = "initialize_velocity_circular" real :: circular_max_u ! The amplitude of the zonal flow [L T-1 ~> m s-1] - real :: dpi ! A local variable storing pi = 3.14159265358979... + real :: dpi ! A local variable storing pi = 3.14159265358979... [nondim] real :: psi1, psi2 ! Values of the streamfunction at two points [L2 T-1 ~> m2 s-1] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1678,16 +1724,24 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, US, param_file, just_r logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing T or S. ! Local variables - real, dimension(SZK_(GV)) :: T0, S0 + real, dimension(SZK_(GV)) :: T0 ! The profile of temperatures [C ~> degC] + real, dimension(SZK_(GV)) :: S0 ! The profile of salinities [S ~> ppt] integer :: i, j, k character(len=200) :: filename, ts_file, inputdir ! Strings for file/path + character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files character(len=40) :: mdl = "initialize_temp_salt_from_profile" if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "TS_FILE", ts_file, & - "The file with the reference profiles for temperature "//& - "and salinity.", fail_if_missing=.not.just_read, do_not_log=just_read) + "The file with the reference profiles for temperature and salinity.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "TEMP_IC_VAR", temp_var, & + "The initial condition variable for potential temperature.", & + default="PTEMP", do_not_log=just_read) + call get_param(param_file, mdl, "SALT_IC_VAR", salt_var, & + "The initial condition variable for salinity.", & + default="SALT", do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -1695,12 +1749,12 @@ subroutine initialize_temp_salt_from_profile(T, S, G, GV, US, param_file, just_r inputdir = slasher(inputdir) filename = trim(inputdir)//trim(ts_file) call log_param(param_file, mdl, "INPUTDIR/TS_FILE", filename) - if (.not.file_exists(filename)) call MOM_error(FATAL, & + if (.not.file_exists(filename)) call MOM_error(FATAL, & " initialize_temp_salt_from_profile: Unable to open "//trim(filename)) ! Read the temperatures and salinities from a netcdf file. - call MOM_read_data(filename, "PTEMP", T0(:), scale=US%degC_to_C) - call MOM_read_data(filename, "SALT", S0(:), scale=US%ppt_to_S) + call MOM_read_data(filename, temp_var, T0(:), scale=US%degC_to_C) + call MOM_read_data(filename, salt_var, S0(:), scale=US%ppt_to_S) do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) @@ -1745,8 +1799,8 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, US, param_file, eqn_of_state, P "A reference temperature used in initialization.", & units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, scale=US%ppt_to_S, do_not_log=just_read) + "A reference salinity used in initialization.", & + units="PSU", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & "If true, accept the prescribed temperature and fit the "//& "salinity; otherwise take salinity and fit temperature.", & @@ -1815,12 +1869,11 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, US, param_file, just_read) !! this call will only read parameters !! without changing T or S. - integer :: k - real :: S_top, T_top ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer - real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical - !real :: delta_S, delta_T - !real :: delta + ! Local variables + real :: S_top, S_range ! Reference salinity in the surface layer and its vertical range [S ~> ppt] + real :: T_top, T_range ! Reference temperature in the surface layer and its vertical range [C ~> degC] character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's name. + integer :: k if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call get_param(param_file, mdl, "T_TOP", T_top, & @@ -1838,25 +1891,18 @@ subroutine initialize_temp_salt_linear(T, S, G, GV, US, param_file, just_read) if (just_read) return ! All run-time parameters have been read, so return. - ! Prescribe salinity - !delta_S = S_range / ( GV%ke - 1.0 ) - !S(:,:,1) = S_top - !do k=2,GV%ke - ! S(:,:,k) = S(:,:,k-1) + delta_S - !enddo + ! Prescribe salinity and temperature, with the extrapolated top interface value prescribed. do k=1,GV%ke S(:,:,k) = S_top - S_range*((real(k)-0.5)/real(GV%ke)) T(:,:,k) = T_top - T_range*((real(k)-0.5)/real(GV%ke)) enddo - ! Prescribe temperature - !delta_T = T_range / ( GV%ke - 1.0 ) - !T(:,:,1) = T_top - !do k=2,GV%ke - ! T(:,:,k) = T(:,:,k-1) + delta_T - !enddo - !delta = 1 - !T(:,:,GV%ke/2 - (delta-1):GV%ke/2 + delta) = 1.0 + ! Prescribe salinity and temperature, but with the top layer value matching the surface value. + ! S(:,:,1) = S_top ; T(:,:,1) = T_top + ! do k=2,GV%ke + ! S(:,:,k) = S_top - S_range * (real(k-1) / real(GV%ke-1)) + ! T(:,:,k) = T_top - T_range * (real(k-1) / real(GV%ke-1)) + ! enddo call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_linear @@ -1894,11 +1940,17 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t real, allocatable, dimension(:,:,:) :: h ! The target interface thicknesses [H ~> m or kg m-2]. real, dimension (SZI_(G),SZJ_(G),SZK_(GV)) :: & - tmp, tmp2 ! A temporary array for tracers. + tmp, & ! A temporary array for temperatures [C ~> degC] or other tracers. + tmp2 ! A temporary array for salinities [S ~> ppt] real, dimension (SZI_(G),SZJ_(G)) :: & - tmp_2d ! A temporary array for tracers. - real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge fields - real, allocatable, dimension(:,:,:) :: tmp_u,tmp_v ! A temporary array for reading sponge fields + tmp_2d ! A temporary array for mixed layer densities [R ~> kg m-3] + real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading sponge target fields + ! on the vertical grid of the input file, used for both + ! temperatures [C ~> degC] and salinities [S ~> ppt] + real, allocatable, dimension(:,:,:) :: tmp_u ! Temporary array for reading sponge target zonal + ! velocities on the vertical grid of the input file [L T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: tmp_v ! Temporary array for reading sponge target meridional + ! velocities on the vertical grid of the input file [L T-1 ~> m s-1] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: Idamp_u(SZIB_(G),SZJ_(G)) ! The sponge damping rate for velocity fields [T-1 ~> s-1] @@ -1917,7 +1969,6 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t character(len=200) :: filename, inputdir ! Strings for file/path and path. logical :: use_ALE ! True if ALE is being used, False if in layered mode - logical :: new_sponge_param ! The value of a deprecated parameter. logical :: time_space_interp_sponge ! If true use sponge data that need to be interpolated in both ! the horizontal dimension and in time prior to vertical remapping. @@ -1973,34 +2024,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t endif call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, default=.false., do_not_log=.true.) - !### NEW_SPONGES should be obsoleted properly, rather than merely deprecated, at which - ! point only the else branch of the new_sponge_param block would be retained. - call get_param(param_file, mdl, "NEW_SPONGES", new_sponge_param, & - "Set True if using the newer sponging code which "//& - "performs on-the-fly regridding in lat-lon-time"//& - "of sponge restoring data.", default=.false., do_not_log=.true.) - if (new_sponge_param) then - call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & - "If True, perform on-the-fly regridding in lat-lon-time of sponge restoring data.", & - default=.true., do_not_log=.true.) - if (.not.time_space_interp_sponge) then - call MOM_error(FATAL, " initialize_sponges: NEW_SPONGES has been deprecated, "//& - "but is set to true inconsistently with INTERPOLATE_SPONGE_TIME_SPACE. "//& - "Remove the NEW_SPONGES input line.") - else - call MOM_error(WARNING, " initialize_sponges: NEW_SPONGES has been deprecated. "//& - "Please use INTERPOLATE_SPONGE_TIME_SPACE instead. Setting "//& - "INTERPOLATE_SPONGE_TIME_SPACE = True.") - endif - call log_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & - "If True, perform on-the-fly regridding in lat-lon-time of sponge restoring data.", & - default=.true.) - else - call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & + call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & "If True, perform on-the-fly regridding in lat-lon-time of sponge restoring data.", & default=.false.) - endif - ! Read in sponge damping rate for tracers filename = trim(inputdir)//trim(damping_file) @@ -2092,8 +2118,8 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t if ( use_temperature) then call MOM_read_data(filename, potemp_var, tmp(:,:,:), G%Domain, scale=US%degC_to_C) call set_up_sponge_field(tmp, tv%T, G, GV, nz, Layer_CSp) - call MOM_read_data(filename, salin_var, tmp(:,:,:), G%Domain, scale=US%ppt_to_S) - call set_up_sponge_field(tmp, tv%S, G, GV, nz, Layer_CSp) + call MOM_read_data(filename, salin_var, tmp2(:,:,:), G%Domain, scale=US%ppt_to_S) + call set_up_sponge_field(tmp2, tv%S, G, GV, nz, Layer_CSp) endif ! else @@ -2196,30 +2222,34 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p oda_incupd_CSp, restart_CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(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. + !! variables. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] (in) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: u !< The zonal velocity that is being + intent(in) :: u !< The zonal velocity that is being !! initialized [L T-1 ~> m s-1] real, 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] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(oda_incupd_CS), pointer :: oda_incupd_CSp !< A pointer that is set to point to the control - !! structure for this module. - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct - type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in - !! overrides any value set for - !Time. + !! structure for this module. + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure + type(time_type), intent(in) :: Time !< Time at the start of the run segment. Time_in + !! overrides any value set for Time. ! Local variables - real, allocatable, dimension(:,:,:) :: hoda ! The layer thk inc. and oda layer thk [H ~> m or kg m-2]. - real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading oda fields - real, allocatable, dimension(:,:,:) :: tmp_u,tmp_v ! A temporary array for reading oda fields + real, allocatable, dimension(:,:,:) :: hoda ! The layer thickness increment and oda layer thickness [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: tmp_tr ! A temporary array for reading oda tracer increments + ! on the vertical grid of the input file, used for both + ! temperatures [C ~> degC] and salinities [S ~> ppt] + real, allocatable, dimension(:,:,:) :: tmp_u ! Temporary array for reading oda zonal velocity + ! increments on the vertical grid of the input file [L T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: tmp_v ! Temporary array for reading oda meridional velocity + ! increments on the vertical grid of the input file [L T-1 ~> m s-1] integer :: is, ie, js, je, nz integer :: isd, ied, jsd, jed @@ -2324,7 +2354,7 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p 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) + deallocate(tmp_u, tmp_v) endif ! calculate increments if input are full fields @@ -2364,8 +2394,8 @@ subroutine compute_global_grid_integrals(G, US) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming - real :: area_scale + real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming ! Masked and unscaled areas for sums [m2] + real :: area_scale ! A conversion factor to prepare for reproducing sums [m2 L-2 ~> 1] integer :: i,j area_scale = US%L_to_m**2 @@ -2439,37 +2469,44 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just integer :: i, j, k, ks integer :: nkml ! The number of layers in the mixed layer. - integer :: kd, inconsistent + integer :: inconsistent ! The total number of cells with in consistent topography and layer thicknesses. + integer :: kd ! The number of levels in the input data integer :: nkd ! number of levels to use for regridding input arrays real :: eps_Z ! A negligibly thin layer thickness [Z ~> m]. real :: eps_rho ! A negligibly small density difference [R ~> kg m-3]. - real :: PI_180 ! for conversion from degrees to radians - real :: Hmix_default ! The default initial mixed layer depth [m]. + real :: PI_180 ! for conversion from degrees to radians [radian degree-1] + real :: Hmix_default ! The default initial mixed layer depth [Z ~> m]. real :: Hmix_depth ! The mixed layer depth in the initial condition [Z ~> m]. - real :: missing_value_temp ! The missing value in the input temperature field - real :: missing_value_salt ! The missing value in the input salinity field - logical :: correct_thickness + real :: missing_value_temp ! The missing value in the input temperature field [C ~> degC] + real :: missing_value_salt ! The missing value in the input salinity field [S ~> ppt] + real :: tol_temp ! The tolerance for changes in temperature during the horizontal + ! interpolation from an input dataset [C ~> degC] + real :: tol_sal ! The tolerance for changes in salinity during the horizontal + ! interpolation from an input dataset [S ~> ppt] + logical :: correct_thickness ! If true, correct the column thicknesses to match the topography real :: h_tolerance ! A parameter that controls the tolerance when adjusting the ! thickness to fit the bathymetry [Z ~> m]. + real :: tol_dz_bot ! A tolerance for detecting inconsistent bottom depths when + ! correct_thickness is false [Z ~> m] character(len=40) :: potemp_var, salin_var integer, parameter :: niter=10 ! number of iterations for t/s adjustment to layer density logical :: adjust_temperature = .true. ! fit t/s to target densities real :: temp_land_fill ! A temperature value to use for land points [C ~> degC] real :: salt_land_fill ! A salinity value to use for land points [C ~> degC] - logical :: reentrant_x, tripolar_n ! data arrays - real, dimension(:), allocatable :: z_edges_in, z_in ! Interface heights [Z ~> m] - real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] + real, dimension(:), allocatable :: z_edges_in ! Input data interface heights or depths [Z ~> m] + real, dimension(:), allocatable :: z_in ! Input data cell heights or depths [Z ~> m] + real, dimension(:), allocatable :: Rb ! Interface densities [R ~> kg m-3] real, dimension(:,:,:), allocatable, target :: temp_z ! Input temperatures [C ~> degC] real, dimension(:,:,:), allocatable, target :: salt_z ! Input salinities [S ~> ppt] real, dimension(:,:,:), allocatable, target :: mask_z ! 1 for valid data points [nondim] - real, dimension(:,:,:), allocatable :: rho_z ! Densities in Z-space [R ~> kg m-3] + 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 ! The number of levels in each column with valid data + 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 ! The number of levels in each column with valid data real, dimension(SZI_(G)) :: press ! Pressures [R L2 T-2 ~> Pa]. ! Local variables for ALE remapping @@ -2478,7 +2515,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real, dimension(:,:,:), allocatable, target :: tmpS1dIn ! Input salinities on a model-sized grid [S ~> ppt] real, dimension(:,:,:), allocatable :: tmp_mask_in ! The valid data mask on a model-sized grid [nondim] real, dimension(:,:,:), allocatable :: h1 ! Thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to regridding + real, dimension(:,:,:), allocatable :: dz_interface ! Change in position of interface due to + ! regridding [H ~> m or kg m-2] real :: zTopOfCell, zBottomOfCell ! Heights in Z units [Z ~> m]. type(regridding_CS) :: regridCS ! Regridding parameters and work arrays type(remapping_CS) :: remapCS ! Remapping parameters and work arrays @@ -2532,9 +2570,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just eos => tv%eqn_of_state - reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x, default=.true.) - tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mdl, "TEMP_SALT_Z_INIT_FILE", filename, & "The name of the z-space input file used to initialize "//& "temperatures (T) and salinities (S). If T and S are not "//& @@ -2605,7 +2640,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "latter takes precedence.", default=default_remap_ans_date, do_not_log=just_read) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & - "If true, use the order of arithmetic for horizonal regridding that recovers "//& + "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) ! Revise inconsistent default answer dates for horizontal regridding. @@ -2616,6 +2651,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=just_read) @@ -2624,12 +2660,16 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If true, all mass below the bottom removed if the "//& "topography is shallower than the thickness input file "//& "would indicate.", default=.false., do_not_log=just_read) - if (correct_thickness) then - call get_param(PF, mdl, "THICKNESS_TOLERANCE", h_tolerance, & + call get_param(PF, mdl, "THICKNESS_TOLERANCE", h_tolerance, & "A parameter that controls the tolerance when adjusting the "//& "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & - units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) - endif + units="m", default=0.1, scale=US%m_to_Z, & + do_not_log=(just_read.or..not.correct_thickness)) + call get_param(PF, mdl, "DZ_BOTTOM_TOLERANCE", tol_dz_bot, & + "A tolerance for detecting inconsistent topography and input layer "//& + "thicknesses when ADJUST_THICKNESS is false.", & + units="m", default=1.0, scale=US%m_to_Z, & + do_not_log=(just_read.or.correct_thickness)) call get_param(PF, mdl, "FIT_TO_TARGET_DENSITY_IC", adjust_temperature, & "If true, all the interior layers are adjusted to "//& @@ -2642,30 +2682,51 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "all layers are initialized based on the depths of their target densities.", & default=.false., do_not_log=just_read.or.(GV%nkml==0)) if (GV%nkml == 0) separate_mixed_layer = .false. - call get_param(PF, mdl, "MINIMUM_DEPTH", Hmix_default, default=0.0) + call get_param(PF, mdl, "MINIMUM_DEPTH", Hmix_default, & + units="m", default=0.0, scale=US%m_to_Z) call get_param(PF, mdl, "Z_INIT_HMIX_DEPTH", Hmix_depth, & "The mixed layer depth in the initial conditions when Z_INIT_SEPARATE_MIXED_LAYER "//& - "is set to true.", default=Hmix_default, units="m", scale=US%m_to_Z, & + "is set to true.", units="m", default=US%Z_to_m*Hmix_default, scale=US%m_to_Z, & do_not_log=(just_read .or. .not.separate_mixed_layer)) + ! Reusing MINIMUM_DEPTH for the default mixed layer depth may be a strange choice, but + ! it reproduces previous answers. + call get_param(PF, mdl, "DENSITY_INTERP_TOLERANCE", eps_rho, & + "A small density tolerance used when finding depths in a density profile.", & + units="kg m-3", default=1.0e-10, scale=US%kg_m3_to_R, & + do_not_log=useALEremapping.or.just_read) call get_param(PF, mdl, "LAYER_Z_INIT_IC_EXTRAP_BUG", density_extrap_bug, & "If true use an expression with a vertical indexing bug for extrapolating the "//& "densities at the bottom of unstable profiles from data when finding the "//& "initial interface locations in layered mode from a dataset of T and S.", & default=.false., do_not_log=just_read) - ! Reusing MINIMUM_DEPTH for the default mixed layer depth may be a strange choice, but - ! it reproduces previous answers. endif + call get_param(PF, mdl, "LAND_FILL_TEMP", temp_land_fill, & + "A value to use to fill in ocean temperatures on land points.", & + units="degC", default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "LAND_FILL_SALIN", salt_land_fill, & + "A value to use to fill in ocean salinities on land points.", & + units="1e-3", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "HORIZ_INTERP_TOL_TEMP", tol_temp, & + "The tolerance in temperature changes between iterations when interpolating "//& + "from an input dataset using horiz_interp_and_extrap_tracer. This routine "//& + "converges slowly, so an overly small tolerance can get expensive.", & + units="degC", default=1.0e-3, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "HORIZ_INTERP_TOL_SALIN", tol_sal, & + "The tolerance in salinity changes between iterations when interpolating "//& + "from an input dataset using horiz_interp_and_extrap_tracer. This routine "//& + "converges slowly, so an overly small tolerance can get expensive.", & + units="1e-3", default=1.0e-3, scale=US%ppt_to_S, do_not_log=just_read) + if (just_read) then + if ((.not.useALEremapping) .and. adjust_temperature) & + ! This call is just here to read and log the determine_temperature parameters + call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), eos, tv%P_Ref, 0, & + h, 0, G, GV, US, PF, just_read=.true.) call cpu_clock_end(id_clock_routine) return ! All run-time parameters have been read, so return. endif - !### These hard-coded constants should be made into runtime parameters - temp_land_fill = 0.0*US%degC_to_C - salt_land_fill = 35.0*US%ppt_to_S - eps_z = GV%Angstrom_Z - eps_rho = 1.0e-10*US%kg_m3_to_R ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the @@ -2682,15 +2743,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var, US%degC_to_C, 1, & - G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date, & - ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%degC_to_C) + call horiz_interp_and_extrap_tracer(tfilename, potemp_var, 1, & + G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, & + scale=US%degC_to_C, homogenize=homogenize, m_to_Z=US%m_to_Z, & + answer_date=hor_regrid_answer_date, ongrid=pre_gridded, tr_iter_tol=tol_temp) - call horiz_interp_and_extrap_tracer(sfilename, salin_var, US%ppt_to_S, 1, & - G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, reentrant_x, & - tripolar_n, homogenize, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date, & - ongrid=pre_gridded, tr_iter_tol=1.0e-3*US%ppt_to_S) + call horiz_interp_and_extrap_tracer(sfilename, salin_var, 1, & + G, salt_z, mask_z, z_in, z_edges_in, missing_value_salt, & + scale=US%ppt_to_S, homogenize=homogenize, m_to_Z=US%m_to_Z, & + answer_date=hor_regrid_answer_date, ongrid=pre_gridded, tr_iter_tol=tol_sal) kd = size(z_in,1) @@ -2716,11 +2777,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just 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 + 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 + if ((tmp_mask_in(i,j,k) > 0.) .and. (k <= kd)) then 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) @@ -2729,8 +2790,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just 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 - tmpT1dIn(i,j,k) = -99.9*US%degC_to_C ! Change to temp_land_fill - tmpS1dIn(i,j,k) = -99.9*US%ppt_to_S ! Change to salt_land_fill + tmpT1dIn(i,j,k) = temp_land_fill + tmpS1dIn(i,j,k) = salt_land_fill endif h1(i,j,k) = GV%Z_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k @@ -2751,7 +2812,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just hTarget = getCoordinateResolution( regridCS ) do j = js, je ; do i = is, ie h(i,j,:) = 0. - if (G%mask2dT(i,j)>0.) then + if (G%mask2dT(i,j) > 0.) then ! Build the target grid combining hTarget and topography zTopOfCell = 0. ; zBottomOfCell = 0. do k = 1, nz @@ -2836,9 +2897,9 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just h(i,j,k) = GV%Z_to_H * (zi(i,j,K) - zi(i,j,K+1)) endif enddo ; enddo ; enddo - inconsistent=0 + inconsistent = 0 do j=js,je ; do i=is,ie - if (abs(zi(i,j,nz+1) - Z_bottom(i,j)) > 1.0*US%m_to_Z) & + if (abs(zi(i,j,nz+1) - Z_bottom(i,j)) > tol_dz_bot) & inconsistent = inconsistent + 1 enddo ; enddo call sum_across_PEs(inconsistent) @@ -2850,39 +2911,22 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just endif endif - call tracer_z_init_array(temp_z, z_edges_in, kd, zi, temp_land_fill, G, nz, nlevs, eps_z, & - tv%T) - call tracer_z_init_array(salt_z, z_edges_in, kd, zi, salt_land_fill, G, nz, nlevs, eps_z, & - tv%S) + call tracer_z_init_array(temp_z, z_edges_in, kd, zi, temp_land_fill, G, nz, nlevs, eps_z, tv%T) + call tracer_z_init_array(salt_z, z_edges_in, kd, zi, salt_land_fill, G, nz, nlevs, eps_z, tv%S) if (homogenize) then ! Horizontally homogenize data to produce perfectly "flat" initial conditions do k=1,nz - nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. - do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then - nPoints = nPoints + 1 - tempAvg = tempAvg + tv%T(i,j,k) - saltAvg = saltAvg + tv%S(i,j,k) - endif ; enddo ; enddo - - !### These averages will not reproduce across PE layouts or grid rotation. - call sum_across_PEs(nPoints) - call sum_across_PEs(tempAvg) - call sum_across_PEs(saltAvg) - if (nPoints>0) then - tempAvg = tempAvg / real(nPoints) - saltAvg = saltAvg / real(nPoints) - endif - tv%T(:,:,k) = tempAvg - tv%S(:,:,k) = saltAvg + call homogenize_field(tv%T(:,:,k), G%mask2dT, G, scale=US%degC_to_C, answer_date=hor_regrid_answer_date) + call homogenize_field(tv%S(:,:,k), G%mask2dT, G, scale=US%ppt_to_S, answer_date=hor_regrid_answer_date) enddo endif if (adjust_temperature) then ! Finally adjust to target density ks = 1 ; if (separate_mixed_layer) ks = GV%nk_rho_varies + 1 - call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), tv%P_Ref, niter, & - h, ks, G, GV, US, eos) + call determine_temperature(tv%T, tv%S, GV%Rlay(1:nz), eos, tv%P_Ref, niter, & + h, ks, G, GV, US, PF, just_read) endif endif ! useALEremapping @@ -2933,7 +2977,7 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n real, dimension(SZK_(GV)+1) :: zi_ ! A column interface heights (negative downward) [Z ~> m]. real :: slope ! The rate of change of height with density [Z R-1 ~> m4 kg-1] real :: drhodz ! A local vertical density gradient [R Z-1 ~> kg m-4] - real, parameter :: zoff=0.999 + real, parameter :: zoff = 0.999 ! A small fractional adjustment to the density differences [nondim] logical :: unstable ! True if the column is statically unstable anywhere. integer :: nlevs_data ! The number of data values in a column. logical :: work_down ! This indicates whether this pass goes up or down the water column. @@ -2948,18 +2992,18 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n nlevs_data = nlevs(i,j) do k=1,nlevs_data ; rho_(k) = rho(i,j,k) ; enddo - unstable=.true. + unstable = .true. work_down = .true. do while (unstable) ! Modify the input profile until it no longer has densities that decrease with depth. - unstable=.false. + unstable = .false. if (work_down) then - do k=2,nlevs_data-1 ; if (rho_(k) - rho_(k-1) < 0.0 ) then + do k=2,nlevs_data-1 ; if (rho_(k) - rho_(k-1) < 0.0) then if (k == 2) then rho_(k-1) = rho_(k) - eps_rho else drhodz = (rho_(k+1)-rho_(k-1)) / (zin(k+1)-zin(k-1)) - if (drhodz < 0.0) unstable=.true. + if (drhodz < 0.0) unstable = .true. rho_(k) = rho_(k-1) + drhodz*zoff*(zin(k)-zin(k-1)) endif endif ; enddo @@ -2974,7 +3018,7 @@ subroutine find_interfaces(rho, zin, nk_data, Rb, Z_bot, zi, G, GV, US, nlevs, n endif else drhodz = (rho_(k+1)-rho_(k-1)) / (zin(k+1)-zin(k-1)) - if (drhodz < 0.0) unstable=.true. + if (drhodz < 0.0) unstable = .true. rho_(k) = rho_(k+1) - drhodz*(zin(k+1)-zin(k)) endif endif ; enddo @@ -3049,6 +3093,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) real :: P_tot, P_t, P_b ! Pressures [R L2 T-2 ~> Pa] real :: z_out ! Output height [Z ~> m] real :: I_z_scale ! The inverse of the height scale for prescribed gradients [Z-1 ~> m-1] + real :: z_tol ! The tolerance with which to find the depth matching a specified pressure [Z ~> m]. integer :: k type(remapping_CS), pointer :: remap_CS => NULL() @@ -3063,6 +3108,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) P_tot = 0. T_ref = 20.0*US%degC_to_C S_ref = 35.0*US%ppt_to_S + z_tol = 1.0e-5*US%m_to_Z do k = 1, nk z(k) = 0.5 * ( e(K) + e(K+1) ) T_t(k) = T_ref + (0. * I_z_scale) * e(k) @@ -3079,7 +3125,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) P_t = 0. do k = 1, nk call find_depth_of_pressure_in_cell(T_t(k), T_b(k), S_t(k), S_b(k), e(K), e(K+1), P_t, 0.5*P_tot, & - GV%Rho0, GV%g_Earth, tv%eqn_of_state, US, P_b, z_out) + GV%Rho0, GV%g_Earth, tv%eqn_of_state, US, P_b, z_out, z_tol=z_tol) write(0,*) k, US%RL2_T2_to_Pa*P_t, US%RL2_T2_to_Pa*P_b, 0.5*US%RL2_T2_to_Pa*P_tot, & US%Z_to_m*e(K), US%Z_to_m*e(K+1), US%Z_to_m*z_out P_t = P_b @@ -3091,7 +3137,7 @@ subroutine MOM_state_init_tests(G, GV, US, tv) write(0,*) '' write(0,*) GV%H_to_m*h(:) call cut_off_column_top(nk, tv, GV, US, GV%g_Earth, -e(nk+1), GV%Angstrom_Z, & - T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS) + T, T_t, T_b, S, S_t, S_b, 0.5*P_tot, h, remap_CS, z_tol=z_tol) write(0,*) GV%H_to_m*h(:) end subroutine MOM_state_init_tests diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 04c03a5b43..bd77ec54d5 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -41,11 +41,12 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized + real, dimension(:,:,:), pointer :: tr !< Pointer to array to be initialized [CU ~> conc] type(param_file_type), intent(in) :: PF !< parameter file character(len=*), intent(in) :: src_file !< source filename character(len=*), intent(in) :: src_var_nam !< variable name in file - real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion + real, optional, intent(in) :: src_var_unit_conversion !< optional multiplicative unit conversion, + !! often used for rescaling into model units [CU conc-1 ~> 1] integer, optional, intent(in) :: src_var_record !< record to read for multiple time-level files logical, optional, intent(in) :: homogenize !< optionally homogenize to mean value logical, optional, intent(in) :: useALEremapping !< to remap or not (optional) @@ -53,11 +54,11 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ character(len=*), optional, intent(in) :: src_var_gridspec !< Source variable name in a gridspec file. !! This is not implemented yet. ! Local variables - real :: land_fill = 0.0 - real :: convert + real :: land_fill = 0.0 ! A value to use to replace missing values [CU ~> conc] + real :: convert ! A conversion factor into the model's internal units [CU conc-1 ~> 1] integer :: recnum character(len=64) :: remapScheme - logical :: homog,useALE + logical :: homog, useALE ! This include declares and sets the variable "version". # include "version_variable.h" @@ -66,8 +67,12 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ integer :: is, ie, js, je, nz ! compute domain indices integer :: isd, ied, jsd, jed ! data domain indices integer :: i, j, k, kd - real, allocatable, dimension(:,:,:), target :: tr_z, mask_z - real, allocatable, dimension(:), target :: z_edges_in, z_in + real, allocatable, dimension(:,:,:), target :: tr_z ! Tracer array on the horizontal model grid + ! and input-file vertical levels [CU ~> conc] + real, allocatable, dimension(:,:,:), target :: mask_z ! Missing value mask on the horizontal model grid + ! and input-file vertical levels [nondim] + real, allocatable, dimension(:), target :: z_edges_in ! Cell edge depths for input data [Z ~> m] + real, allocatable, dimension(:), target :: z_in ! Cell center depths for input data [Z ~> m] ! Local variables for ALE remapping real, dimension(:,:,:), allocatable :: hSrc ! Source thicknesses [H ~> m or kg m-2]. @@ -75,8 +80,8 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ real :: zTopOfCell, zBottomOfCell, z_bathy ! Heights [Z ~> m]. type(remapping_CS) :: remapCS ! Remapping parameters and work arrays - real :: missing_value - integer :: nPoints + real :: missing_value ! A value indicating that there is no valid input data at this point [CU ~> conc] + integer :: nPoints ! The number of valid input data points in a column integer :: id_clock_routine, id_clock_ALE integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -94,7 +99,6 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! for horizontal regridding. Values below 20190101 recover the ! answers from 2018, while higher values use expressions that have ! been rearranged for rotational invariance. - logical :: reentrant_x, tripolar_n id_clock_routine = cpu_clock_id('(Initialize tracer from Z)', grain=CLOCK_ROUTINE) id_clock_ALE = cpu_clock_id('(Initialize tracer from Z) ALE', grain=CLOCK_LOOP) @@ -150,25 +154,21 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) - ! These are model grid properties, but being applied to the data grid for now. - ! need to revisit this (mjh) - reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) - tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) - if (PRESENT(homogenize)) homog=homogenize if (PRESENT(useALEremapping)) useALE=useALEremapping if (PRESENT(remappingScheme)) remapScheme=remappingScheme - recnum=1 + recnum = 1 if (PRESENT(src_var_record)) recnum = src_var_record - convert=1.0 + convert = 1.0 if (PRESENT(src_var_unit_conversion)) convert = src_var_unit_conversion - call horiz_interp_and_extrap_tracer(src_file, src_var_nam, convert, recnum, & - G, tr_z, mask_z, z_in, z_edges_in, missing_value, reentrant_x, tripolar_n, & - homog, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(src_file, src_var_nam, recnum, & + G, tr_z, mask_z, z_in, z_edges_in, missing_value, & + scale=convert, homogenize=homog, m_to_Z=US%m_to_Z, answer_date=hor_regrid_answer_date) kd = size(z_edges_in,1)-1 call pass_var(tr_z,G%Domain) @@ -221,7 +221,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ ! Fill land values do k=1,nz ; do j=js,je ; do i=is,ie if (tr(i,j,k) == missing_value) then - tr(i,j,k)=land_fill + tr(i,j,k) = land_fill endif enddo ; enddo ; enddo diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index fd49ec5a98..8a1aab3328 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -103,8 +103,12 @@ module MOM_oda_driver_mod type(domain2d), pointer :: mpp_domain => NULL() !< Pointer to a mpp domain object for DA 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 + real, pointer, dimension(:,:,:) :: T_tend => NULL() ! degC s-1] + real, pointer, dimension(:,:,:) :: S_tend => NULL() ! ppt s-1] + real, pointer, dimension(:,:,:) :: T_bc_tend => NULL() !< The layer temperature tendency due + !! to bias adjustment [C T-1 ~> degC s-1] + real, pointer, dimension(:,:,:) :: S_bc_tend => NULL() !< The layer salinity tendency due + !! to bias adjustment [S T-1 ~> ppt s-1] integer :: ni !< global i-direction grid size integer :: nj !< global j-direction grid size logical :: reentrant_x !< grid is reentrant in the x direction @@ -120,7 +124,7 @@ module MOM_oda_driver_mod integer :: ensemble_id = 0 !< id of the current ensemble member integer, pointer, dimension(:,:) :: ensemble_pelist !< PE list for ensemble members integer, pointer, dimension(:) :: filter_pelist !< PE list for ensemble members - integer :: assim_frequency !< analysis interval in hours + real :: assim_interval !< analysis interval [ T ~> s] ! Profiles local to the analysis domain type(ocean_profile_type), pointer :: Profiles => NULL() !< pointer to linked list of all available profiles type(ocean_profile_type), pointer :: CProfiles => NULL()!< pointer to linked list of current profiles @@ -174,6 +178,7 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) integer :: npes_pm, ens_info(6) character(len=30) :: coord_mode character(len=200) :: inputdir, basin_file + character(len=80) :: basin_var character(len=80) :: remap_scheme character(len=80) :: bias_correction_file, inc_file logical :: answers_2018 ! If true, use the order of arithmetic and expressions that recover the @@ -197,8 +202,15 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) call get_param(PF, mdl, "ASSIM_METHOD", assim_method, & "String which determines the data assimilation method "//& "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default='NO_ASSIM') - call get_param(PF, mdl, "ASSIM_FREQUENCY", CS%assim_frequency, & - "data assimilation frequency in hours") + call get_param(PF, mdl, "ASSIM_INTERVAL", CS%assim_interval, & + "data assimilation update interval in hours",default=-1.0,units="hours",scale=3600.*US%s_to_T) + if (CS%assim_interval < 0.) then + call get_param(PF, mdl, "ASSIM_FREQUENCY", CS%assim_interval, & + "data assimilation update in hours. This parameter name will \n"//& + "be deprecated in the future. ASSIM_INTERVAL should be used instead.",default=-1.0, & + units="hours",scale=3600.*US%s_to_T) + endif + call get_param(PF, mdl, "USE_REGRIDDING", CS%use_ALE_algorithm , & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) @@ -218,7 +230,7 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) if (CS%do_bias_adjustment) then call get_param(PF, mdl, "TRACER_ADJUSTMENT_FACTOR", CS%bias_adjustment_multiplier, & "A multiplicative scaling factor for the climatological tracer tendency adjustment ", & - default=1.0) + units="nondim", default=1.0) endif call get_param(PF, mdl, "USE_BASIN_MASK", CS%use_basin_mask, & "If true, add a basin mask to delineate weakly connected "//& @@ -337,9 +349,9 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) ! assign thicknesses call ALE_initThicknessToCoord(CS%ALE_CS, G, CS%GV, CS%h) endif - 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) + + allocate(CS%T_tend(isd:ied,jsd:jed,CS%GV%ke), source=0.0) + allocate(CS%S_tend(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 @@ -348,27 +360,28 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) 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") + "A file in which to find the basin masks.", default="basin.nc") basin_file = trim(inputdir) // trim(basin_file) + call get_param(PF, 'oda_driver', "BASIN_VAR", basin_var, & + "The basin mask variable in BASIN_FILE.", default="basin") 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) + call MOM_read_data(basin_file, basin_var, CS%oda_grid%basin_mask, CS%Grid%domain, timelevel=1) endif ! 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,& + CS%id_inc_t = register_diag_field('ocean_model', 'temp_increment', diag_CS%axesTL, & Time, 'ocean potential temperature increments', 'degC', conversion=US%C_to_degC) - CS%id_inc_s=register_diag_field('ocean_model','salt_increment',diag_CS%axesTL,& + CS%id_inc_s = register_diag_field('ocean_model', 'salt_increment', diag_CS%axesTL, & Time, 'ocean salinity increments', 'psu', conversion=US%S_to_ppt) !! get global grid information from ocean model needed for ODA initialization - T_grid=>NULL() + 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 + CS%Time = Time !! switch back to ensemble member pelist call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) @@ -385,9 +398,9 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) CS%INC_CS%fldno = 2 if (CS%nk /= 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) + + allocate(CS%T_bc_tend(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%S_bc_tend(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -466,17 +479,15 @@ end subroutine set_prior_tracer !> Returns posterior adjustments or full state !!Note that only those PEs associated with an ensemble member receive data -subroutine get_posterior_tracer(Time, CS, h, tv, increment) +subroutine get_posterior_tracer(Time, CS, increment) type(time_type), intent(in) :: Time !< the current model time type(ODA_CS), pointer :: CS !< ocean DA control structure - 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 :: m logical :: get_inc - integer :: seconds_per_hour = 3600. + ! return if not analysis time (retain pointers for h and tv) if (Time < CS%Time .or. CS%assim_method == NO_ASSIM) return @@ -485,7 +496,7 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) !! switch to global pelist call set_PElist(CS%filter_pelist) call MOM_mesg('Getting 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. @@ -501,30 +512,27 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) do m=1,CS%ensemble_size if (get_inc) then call redistribute_array(CS%mpp_domain, Ocean_increment%T(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + CS%domains(m)%mpp_domain, CS%T_tend, complete=.true.) call redistribute_array(CS%mpp_domain, Ocean_increment%S(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + CS%domains(m)%mpp_domain, CS%S_tend, complete=.true.) else call redistribute_array(CS%mpp_domain, CS%Ocean_posterior%T(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%T, complete=.true.) + CS%domains(m)%mpp_domain, CS%T_tend, complete=.true.) call redistribute_array(CS%mpp_domain, CS%Ocean_posterior%S(:,:,:,m),& - CS%domains(m)%mpp_domain, CS%tv%S, complete=.true.) + CS%domains(m)%mpp_domain, CS%S_tend, complete=.true.) endif enddo - if (present(tv)) tv => CS%tv - if (present(h)) h => CS%h - !! 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)) + call pass_var(CS%T_tend,CS%domains(CS%ensemble_id)) + call pass_var(CS%S_tend,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) + CS%T_tend = CS%T_tend / (CS%assim_interval) + CS%S_tend = CS%S_tend / (CS%assim_interval) end subroutine get_posterior_tracer @@ -557,19 +565,23 @@ subroutine get_bias_correction_tracer(Time, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ODA_CS), pointer :: CS !< ocean DA control structure + ! Local variables + real, allocatable, dimension(:,:,:) :: T_bias ! Estimated temperature tendency bias [C T-1 ~> degC s-1] + real, allocatable, dimension(:,:,:) :: S_bias ! Estimated salinity tendency bias [S T-1 ~> ppt s-1] + real, allocatable, dimension(:,:,:) :: valid_flag ! Valid value flag on the horizontal model grid + ! and input-file vertical levels [nondim] + real, allocatable, dimension(:), target :: z_in ! Cell center depths for input data [Z ~> m] + real, allocatable, dimension(:), target :: z_edges_in ! Cell edge depths for input data [Z ~> m] + real :: missing_value ! A value indicating that there is no valid input data at this point [CU ~> conc] + integer, dimension(3) :: fld_sz integer :: i,j,k - real, allocatable, dimension(:,:,:) :: T_bias ! Temperature biases [C ~> degC] - real, allocatable, dimension(:,:,:) :: S_bias ! Salinity biases [C ~> degC] - 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, US%degC_to_C, 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, US%ppt_to_S, CS%G, S_bias, & - mask_z, z_in, z_edges_in, missing_value, .true., .false., .false., .true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id, Time, CS%G, T_bias, & + valid_flag, z_in, z_edges_in, missing_value, scale=US%degC_to_C*US%s_to_T, spongeOngrid=.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id, Time, CS%G, S_bias, & + valid_flag, z_in, z_edges_in, missing_value, scale=US%ppt_to_S*US%s_to_T, spongeOngrid=.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. @@ -577,17 +589,21 @@ subroutine get_bias_correction_tracer(Time, US, CS) do i=1,fld_sz(1) do j=1,fld_sz(2) do k=1,fld_sz(3) - if (T_bias(i,j,k) > 1.0E-3*US%degC_to_C) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) > 1.0E-3*US%ppt_to_S) S_bias(i,j,k) = 0.0 +! if (T_bias(i,j,k) > 1.0E-3*US%degC_to_C) T_bias(i,j,k) = 0.0 +! if (S_bias(i,j,k) > 1.0E-3*US%ppt_to_S) S_bias(i,j,k) = 0.0 + if (valid_flag(i,j,k)==0.) then + T_bias(i,j,k)=0.0 + S_bias(i,j,k)=0.0 + endif enddo enddo enddo - CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier - CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + CS%T_bc_tend = T_bias * CS%bias_adjustment_multiplier + CS%S_bc_tend = 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 pass_var(CS%T_bc_tend, CS%domains(CS%ensemble_id)) + call pass_var(CS%S_bc_tend, CS%domains(CS%ensemble_id)) call cpu_clock_end(id_clock_bias_adjustment) @@ -635,8 +651,8 @@ subroutine set_analysis_time(Time,CS) integer :: yr, mon, day, hr, min, sec if (Time >= CS%Time) then - ! increment the analysis time to the next step converting to seconds - CS%Time = CS%Time + real_to_time(CS%US%T_to_s*(CS%assim_frequency*3600.)) + ! increment the analysis time to the next step + CS%Time = CS%Time + real_to_time(CS%US%T_to_s*(CS%assim_interval)) call get_date(Time, yr, mon, day, hr, min, sec) write(mesg,*) 'Model Time: ', yr, mon, day, hr, min, sec @@ -657,7 +673,7 @@ end subroutine set_analysis_time !> Apply increments to tracers subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) - real, intent(in) :: dt !< The tracer timestep [s] + real, intent(in) :: dt !< The tracer timestep [T ~> 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 @@ -669,12 +685,14 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) !! local variables integer :: i, j integer :: isc, iec, jsc, jec - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_inc !< an adjustment to the temperature + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_tend_inc !< an adjustment to the temperature !! tendency [C T-1 -> degC s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_inc !< an adjustment to the salinity + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_tend_inc !< an adjustment to the salinity !! tendency [S T-1 -> ppt s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T !< The updated temperature [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S !< The updated salinity [S ~> ppt] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: T_tend !< The temperature tendency adjustment from + !! DA [C T-1 ~> degC s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(CS%Grid)) :: S_tend !< The salinity tendency adjustment from DA + !! [S T-1 ~> ppt s-1] real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] if (.not. associated(CS)) return @@ -682,14 +700,14 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) call cpu_clock_begin(id_clock_apply_increments) - T_inc(:,:,:) = 0.0; S_inc(:,:,:) = 0.0; T(:,:,:) = 0.0; S(:,:,:) = 0.0 + T_tend_inc(:,:,:) = 0.0; S_tend_inc(:,:,:) = 0.0; T_tend(:,:,:) = 0.0; S_tend(:,:,:) = 0.0 if (CS%assim_method > 0 ) then - T = T + CS%tv%T - S = S + CS%tv%S + T_tend = T_tend + CS%T_tend + S_tend = S_tend + CS%S_tend endif if (CS%do_bias_adjustment ) then - T = T + CS%tv_bc%T - S = S + CS%tv_bc%S + T_tend = T_tend + CS%T_bc_tend + S_tend = S_tend + CS%S_bc_tend endif if (CS%answer_date >= 20190101) then @@ -702,25 +720,25 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) 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,:), h_neglect, h_neglect_edge) - call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S(i,j,:), & - G%ke, h(i,j,:), S_inc(i,j,:), h_neglect, h_neglect_edge) + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), T_tend(i,j,:), & + G%ke, h(i,j,:), T_tend_inc(i,j,:), h_neglect, h_neglect_edge) + call remapping_core_h(CS%remapCS, CS%nk, CS%h(i,j,:), S_tend(i,j,:), & + G%ke, h(i,j,:), S_tend_inc(i,j,:), h_neglect, h_neglect_edge) enddo; enddo - call pass_var(T_inc, G%Domain) - call pass_var(S_inc, G%Domain) + call pass_var(T_tend_inc, G%Domain) + call pass_var(S_tend_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 + tv%T(isc:iec,jsc:jec,:) = tv%T(isc:iec,jsc:jec,:) + T_tend_inc(isc:iec,jsc:jec,:)*dt + tv%S(isc:iec,jsc:jec,:) = tv%S(isc:iec,jsc:jec,:) + S_tend_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) + if (CS%id_inc_t > 0) call post_data(CS%id_inc_t, T_tend_inc, CS%diag_CS) + if (CS%id_inc_s > 0) call post_data(CS%id_inc_s, S_tend_inc, CS%diag_CS) call disable_averaging(CS%diag_CS) call diag_update_remap_grids(CS%diag_CS) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index ead6086346..add2d6a984 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -45,7 +45,7 @@ module MOM_MEKE integer, parameter :: RV_IDX = 3 !< Index of surface relative vorticity in the feature array integer, parameter :: RD_DX_Z_IDX = 4 !< Index of the radius of deformation over the grid size in the feature array -integer, parameter :: EKE_PROG = 1 !< Use prognostic equation to calcualte EKE +integer, parameter :: EKE_PROG = 1 !< Use prognostic equation to calculate EKE integer, parameter :: EKE_FILE = 2 !< Read in EKE from a file integer, parameter :: EKE_DBCLIENT = 3 !< Infer EKE using a neural network @@ -58,7 +58,7 @@ module MOM_MEKE real :: MEKE_GMECoeff !< Efficiency of conversion of MEKE into ME by GME [nondim] real :: MEKE_damping !< Local depth-independent MEKE dissipation rate [T-1 ~> s-1]. real :: MEKE_Cd_scale !< The ratio of the bottom eddy velocity to the column mean - !! eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 + !! eddy velocity, i.e. sqrt(2*MEKE), [nondim]. This should be less than 1 !! to account for the surface intensification of MEKE. real :: MEKE_Cb !< Coefficient in the \f$\gamma_{bot}\f$ expression [nondim] real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed [nondim] @@ -67,17 +67,21 @@ module MOM_MEKE logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC !! framework (Marshall et al., 2012) real :: MEKE_GEOMETRIC_alpha !< The nondimensional coefficient governing the efficiency of the - !! GEOMETRIC thickness diffusion. + !! GEOMETRIC thickness diffusion [nondim]. logical :: MEKE_equilibrium_alt !< If true, use an alternative calculation for the !! equilibrium value of MEKE. logical :: MEKE_equilibrium_restoring !< If true, restore MEKE back to its equilibrium value, !! which is calculated at each time step. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the MEKE GM source term. + real :: MEKE_min_depth_tot !< The minimum total depth over which to distribute MEKE energy + !! sources from GM energy conversion [Z ~> m]. When the total + !! depth is less than this, the sources are scaled away. logical :: Rd_as_max_scale !< If true the length scale can not exceed the !! first baroclinic deformation radius. logical :: use_old_lscale !< Use the old formula for mixing length scale. logical :: use_min_lscale !< Use simple minimum for mixing length scale. + real :: lscale_maxval !< The ceiling on the MEKE mixing length scale when use_min_lscale is true [L ~> m]. real :: cdrag !< The bottom drag coefficient for MEKE [nondim]. real :: MEKE_BGsrc !< Background energy source for MEKE [L2 T-3 ~> W kg-1] (= m2 s-3). real :: MEKE_dtScale !< Scale factor to accelerate time-stepping [nondim] @@ -89,10 +93,10 @@ module MOM_MEKE !! MEKE itself [nondim]. real :: viscosity_coeff_Ku !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral harmonic momentum mixing - !! by unresolved eddies represented by MEKE. + !! by unresolved eddies represented by MEKE [nondim]. real :: viscosity_coeff_Au !< The scaling coefficient in the expression for !! viscosity used to parameterize lateral biharmonic momentum mixing - !! by unresolved eddies represented by MEKE. + !! by unresolved eddies represented by MEKE [nondim]. real :: Lfixed !< Fixed mixing length scale [L ~> m]. real :: aDeform !< Weighting towards deformation scale of mixing length [nondim] real :: aRhines !< Weighting towards Rhines scale of mixing length [nondim] @@ -137,7 +141,7 @@ module MOM_MEKE logical :: online_analysis !< If true, post the EKE used in MOM6 at every timestep character(len=5) :: model_key = 'mleke' !< Key where the ML-model is stored character(len=7) :: key_suffix !< Suffix appended to every key sent to Redis - real :: eke_max !< The maximum value of EKE considered physically reasonable + real :: eke_max !< The maximum value of EKE considered physically reasonable [L2 T-2 ~> m2 s-2] ! Clock ids integer :: id_client_init !< Clock id to time initialization of the client @@ -169,30 +173,30 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumlated zonal mass flux [H L2 ~> m3 or kg]. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumlated meridional mass flux [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: hu !< Accumulated zonal mass flux [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: hv !< Accumulated meridional mass flux [H L2 ~> m3 or kg] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(in) :: tv !< Type containing thermodynamic variables type(time_type), intent(in) :: Time !< The time used for interpolating EKE ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - data_eke, & ! EKE from file + data_eke, & ! EKE from file [L2 T-2 ~> m2 s-2] mass, & ! The total mass of the water column [R Z ~> kg m-2]. I_mass, & ! The inverse of mass [R-1 Z-1 ~> m2 kg-1]. depth_tot, & ! The depth of the water column [Z ~> m]. 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_visc, & ! Near-bottom velocity contribution to bottom drag [L T-1 ~> m s-1] drag_rate, & ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. del2MEKE, & ! Laplacian of MEKE, used for bi-harmonic diffusion [T-2 ~> s-2]. del4MEKE, & ! Time-integrated MEKE tendency arising from the biharmonic of MEKE [L2 T-2 ~> m2 s-2]. LmixScale, & ! Eddy mixing length [L ~> m]. barotrFac2, & ! Ratio of EKE_barotropic / EKE [nondim] bottomFac2, & ! Ratio of EKE_bottom / EKE [nondim] - tmp, & ! Temporary variable for diagnostic computation - equilibrium_value ! The equilbrium value of MEKE to be calculated at each + tmp, & ! Temporary variable for computation of diagnostic velocities [L T-1 ~> m s-1] + equilibrium_value ! The equilibrium value of MEKE to be calculated at each ! time step [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -200,20 +204,18 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h ! In one place, MEKE_uflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_u, & ! The zonal diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHu, & ! Depth integrated accumulated zonal mass flux [R Z L2 ~> kg]. - drag_vel_u ! A (vertical) viscosity associated with bottom drag at - ! u-points [Z T-1 ~> m s-1]. + drag_vel_u ! A (vertical) viscosity associated with bottom drag at u-points [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G)) :: & MEKE_vflux, & ! The meridional advective and diffusive flux of MEKE with units of [R Z L4 T-3 ~> kg m2 s-3]. ! In one place, MEKE_vflux is used as temporary work space with units of [L2 T-2 ~> m2 s-2]. Kh_v, & ! The meridional diffusivity that is actually used [L2 T-1 ~> m2 s-1]. baroHv, & ! Depth integrated accumulated meridional mass flux [R Z L2 ~> kg]. - drag_vel_v ! A (vertical) viscosity associated with bottom drag at - ! v-points [Z T-1 ~> m s-1]. + drag_vel_v ! A (vertical) viscosity associated with bottom drag at v-points [Z T-1 ~> m s-1]. real :: Kh_here ! The local horizontal viscosity [L2 T-1 ~> m2 s-1] real :: Inv_Kh_max ! The inverse of the local horizontal viscosity [T L-2 ~> s m-2] real :: K4_here ! The local horizontal biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Inv_K4_max ! The inverse of the local horizontal biharmonic viscosity [T L-4 ~> s m-4] - real :: cdrag2 + real :: cdrag2 ! The square of the drag coefficient [nondim] 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]. @@ -223,7 +225,9 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h real :: sdt_damp ! dt for damping [T ~> s] (sdt could be split). logical :: use_drag_rate ! Flag to indicate drag_rate is finite integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real(kind=real32), dimension(size(MEKE%MEKE),NUM_FEATURES) :: features_array + real(kind=real32), dimension(size(MEKE%MEKE),NUM_FEATURES) :: features_array ! The array of features + ! needed for the machine learning inference, with different + ! units for the various subarrays [various] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -256,7 +260,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h call hchksum(MEKE%MEKE, 'MEKE MEKE', G%HI, scale=US%L_T_to_m_s**2) call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI, scale=US%s_to_T, & scalar_pair=.true.) - call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, & + call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=0, symmetric=.true., & scale=GV%H_to_m*(US%L_to_m**2)) endif @@ -289,7 +293,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h enddo ; enddo enddo if (CS%MEKE_advection_bug) then - ! This code obviously incorrect code reproduces a bug in the original implementation of + ! This obviously incorrect code reproduces a bug in the original implementation of ! the MEKE advection. do j=js,je ; do I=is-1,ie baroHu(I,j) = hu(I,j,nz) * GV%H_to_RZ @@ -397,7 +401,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, depth_tot(i,j))) + (GV%Rho0 * MAX(CS%MEKE_min_depth_tot, depth_tot(i,j))) enddo ; enddo else !$OMP parallel do default(shared) @@ -623,7 +627,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h endif case(EKE_FILE) - call time_interp_external(CS%id_eke,Time,data_eke) + call time_interp_external(CS%id_eke, Time, data_eke, scale=US%m_s_to_L_T**2) do j=js,je ; do i=is,ie MEKE%MEKE(i,j) = data_eke(i,j) * G%mask2dT(i,j) enddo; enddo @@ -753,14 +757,15 @@ 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) :: 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 :: beta ! Combined topographic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] real :: SN ! The local Eady growth rate [T-1 ~> s-1] real :: bottomFac2, barotrFac2 ! Vertical structure factors [nondim] real :: LmixScale, LRhines, LEady ! Various mixing length scales [L ~> m] - real :: I_H, KhCoeff + real :: I_H ! The inverse of the total column mass, converted to an inverse horizontal length [L-1 ~> m-1] + real :: KhCoeff ! A copy of MEKE_KhCoeff from the control structure [nondim] real :: Kh ! A lateral diffusivity [L2 T-1 ~> m2 s-1] real :: Ubg2 ! Background (tidal?) velocity squared [L2 T-2 ~> m2 s-2] - real :: cd2 + real :: cd2 ! The square of the drag coefficient [nondim] real :: drag_rate ! The MEKE spindown timescale due to bottom drag [T-1 ~> s-1]. real :: src ! The sum of MEKE sources [L2 T-3 ~> W kg-1] real :: ldamping ! The MEKE damping rate [T-1 ~> s-1]. @@ -916,7 +921,7 @@ subroutine MEKE_equilibrium_restoring(CS, G, US, SN_u, SN_v, depth_tot, & ! Local variables real :: SN ! The local Eady growth rate [T-1 ~> s-1] integer :: i, j, is, ie, js, je ! local indices - real :: cd2 ! bottom drag + real :: cd2 ! The square of the drag coefficient [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec cd2 = CS%cdrag**2 @@ -952,7 +957,7 @@ subroutine MEKE_lengthScales(CS, MEKE, G, GV, US, SN_u, SN_v, EKE, depth_tot, & 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] - real :: beta ! Combined topograpic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] + real :: beta ! Combined topographic and planetary vorticity gradient [T-1 L-1 ~> s-1 m-1] real :: SN ! The local Eady growth rate [T-1 ~> s-1] real :: 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] @@ -1011,7 +1016,7 @@ end subroutine MEKE_lengthScales !> Calculates the eddy mixing length scale and \f$\gamma_b\f$ and \f$\gamma_t\f$ !! functions that are ratios of either bottom or barotropic eddy energy to the !! column eddy energy, respectively. See \ref section_MEKE_equations. -subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, & +subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) type(MEKE_CS), intent(in) :: CS !< MEKE control structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1021,10 +1026,8 @@ subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z real, intent(in) :: Rd_dx !< Resolution Ld/dx [nondim]. real, intent(in) :: SN !< Eady growth rate [T-1 ~> s-1]. real, intent(in) :: EKE !< Eddy kinetic energy [L2 T-2 ~> m2 s-2]. -! real, intent(in) :: Z_to_L !< A conversion factor from depth units (Z) to -! !! the units for lateral distances (L). - real, intent(out) :: bottomFac2 !< gamma_b^2 - real, intent(out) :: barotrFac2 !< gamma_t^2 + real, intent(out) :: bottomFac2 !< gamma_b^2 [nondim] + real, intent(out) :: barotrFac2 !< gamma_t^2 [nondim] real, intent(out) :: LmixScale !< Eddy mixing length [L ~> m]. real, intent(out) :: Lrhines !< Rhines length scale [L ~> m]. real, intent(out) :: Leady !< Eady length scale [L ~> m]. @@ -1061,7 +1064,7 @@ subroutine MEKE_lengthScales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z Leady = 0. endif if (CS%use_min_lscale) then - LmixScale = 1.e7*US%m_to_L + LmixScale = CS%lscale_maxval if (CS%aDeform*Ldeform > 0.) LmixScale = min(LmixScale,CS%aDeform*Ldeform) if (CS%aFrict *Lfrict > 0.) LmixScale = min(LmixScale,CS%aFrict *Lfrict) if (CS%aRhines*Lrhines > 0.) LmixScale = min(LmixScale,CS%aRhines*Lrhines) @@ -1093,16 +1096,16 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. type(MEKE_CS), intent(inout) :: CS !< MEKE control structure. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure logical, intent( out) :: meke_in_dynamics !< If true, MEKE is stepped forward in dynamics !! otherwise in tracer dynamics ! Local variables real :: I_T_rescale ! A rescaling factor for time from the internal representation in this - ! run to the representation in a restart file. + ! run to the representation in a restart file, [nondim]? real :: L_rescale ! A rescaling factor for length from the internal representation in this - ! run to the representation in a restart file. - real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value. + ! run to the representation in a restart file, [nondim]? + real :: MEKE_restoring_timescale ! The timescale used to nudge MEKE toward its equilibrium value [T ~> s] real :: cdrag ! The default bottom drag coefficient [nondim]. character(len=200) :: eke_filename, eke_varname, inputdir character(len=16) :: eke_source_str @@ -1196,8 +1199,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "each time step.", default=.false.) if (CS%MEKE_equilibrium_restoring) then call get_param(param_file, mdl, "MEKE_RESTORING_TIMESCALE", MEKE_restoring_timescale, & - "The timescale used to nudge MEKE toward its equilibrium value.", units="s", & - default=1e6, scale=US%s_to_T) + "The timescale used to nudge MEKE toward its equilibrium value.", & + units="s", default=1e6, scale=US%s_to_T) CS%MEKE_restoring_rate = 1.0 / MEKE_restoring_timescale endif @@ -1210,8 +1213,8 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "by GME. If MEKE_GMECOEFF is negative, this conversion "//& "is not used or calculated.", units="nondim", default=-1.0) call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & - "A background energy source for MEKE.", units="W kg-1", & - default=0.0, scale=US%m_to_L**2*US%T_to_s**3) + "A background energy source for MEKE.", & + units="W kg-1", default=0.0, scale=US%m_to_L**2*US%T_to_s**3) call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE. "//& "Use a negative value to not apply lateral diffusion to MEKE.", & @@ -1229,7 +1232,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, case default call MOM_error(FATAL, "Invalid method selected for calculating EKE") end select - ! GMM, make sure all params used to calculated MEKE are within the above if + ! GMM, make sure all parameters used to calculated MEKE are within the above if call get_param(param_file, mdl, "MEKE_KHCOEFF", CS%MEKE_KhCoeff, & "A scaling factor in the expression for eddy diffusivity "//& @@ -1244,15 +1247,17 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, call get_param(param_file, mdl, "MEKE_GM_SRC_ALT", CS%GM_src_alt, & "If true, use the GM energy conversion form S^2*N^2*kappa rather "//& "than the streamfunction for the MEKE GM source term.", default=.false.) + call get_param(param_file, mdl, "MEKE_MIN_DEPTH_TOT", CS%MEKE_min_depth_tot, & + "The minimum total depth over which to distribute MEKE energy sources. "//& + "When the total depth is less than this, the sources are scaled away.", & + units="m", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%GM_src_alt) call get_param(param_file, mdl, "MEKE_VISC_DRAG", CS%visc_drag, & "If true, use the vertvisc_type to calculate the bottom "//& "drag acting on MEKE.", default=.true.) call get_param(param_file, mdl, "MEKE_KHTH_FAC", MEKE%KhTh_fac, & - "A factor that maps MEKE%Kh to KhTh.", units="nondim", & - default=0.0) + "A factor that maps MEKE%Kh to KhTh.", units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_KHTR_FAC", MEKE%KhTr_fac, & - "A factor that maps MEKE%Kh to KhTr.", units="nondim", & - default=0.0) + "A factor that maps MEKE%Kh to KhTr.", units="nondim", default=0.0) call get_param(param_file, mdl, "MEKE_KHMEKE_FAC", CS%KhMEKE_Fac, & "A factor that maps MEKE%Kh to Kh for MEKE itself.", & units="nondim", default=0.0) @@ -1264,10 +1269,15 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, "If true, use a strict minimum of provided length scales "//& "rather than harmonic mean.", & default=.false.) + call get_param(param_file, mdl, "MEKE_LSCALE_MAX_VAL", CS%lscale_maxval, & + "The ceiling on the value of the MEKE length scale when MEKE_MIN_LSCALE=True. "//& + "The default is the distance from the equator to the pole on Earth, as "//& + "estimated by enlightenment era scientists, but should probably scale with RAD_EARTH.", & + units="m", default=1.0e7, scale=US%m_to_L, do_not_log=.not.CS%use_min_lscale) call get_param(param_file, mdl, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & "If true, the length scale used by MEKE is the minimum of "//& "the deformation radius or grid-spacing. Only used if "//& - "MEKE_OLD_LSCALE=True", units="nondim", default=.false.) + "MEKE_OLD_LSCALE=True", default=.false.) call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF_KU", CS%viscosity_coeff_Ku, & "If non-zero, is the scaling coefficient in the expression for"//& "viscosity used to parameterize harmonic lateral momentum mixing by"//& @@ -1336,13 +1346,11 @@ logical function MEKE_init(Time, G, US, param_file, diag, dbcomms_CS, CS, MEKE, ! Nonlocal module parameters call get_param(param_file, mdl, "CDRAG", cdrag, & - "CDRAG is the drag coefficient relating the magnitude of "//& - "the velocity field to the bottom stress.", units="nondim", & - default=0.003) + "CDRAG is the drag coefficient relating the magnitude of the velocity "//& + "field to the bottom stress.", units="nondim", default=0.003) call get_param(param_file, mdl, "MEKE_CDRAG", CS%cdrag, & "Drag coefficient relating the magnitude of the velocity "//& - "field to the bottom stress in MEKE.", units="nondim", & - default=cdrag) + "field to the bottom stress in MEKE.", units="nondim", default=cdrag) call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) call get_param(param_file, mdl, "BIHARMONIC", biharmonic, default=.false., do_not_log=.true.) @@ -1522,7 +1530,8 @@ subroutine ML_MEKE_init(diag, G, US, Time, param_file, dbcomms_CS, CS) call get_param(param_file, mdl, "EKE_MODEL", model_filename, & "Filename of the a saved pyTorch model to use", fail_if_missing = .true.) call get_param(param_file, mdl, "EKE_MAX", CS%eke_max, & - "Maximum value of EKE allowed when inferring EKE", default=2., scale=US%L_T_to_m_s**2) + "Maximum value of EKE allowed when inferring EKE", & + units="m2 s-2", default=2., scale=US%L_T_to_m_s**2) ! Set the machine learning model if (dbcomms_CS%colocated) then @@ -1553,13 +1562,13 @@ subroutine ML_MEKE_init(diag, G, US, Time, param_file, dbcomms_CS, CS) CS%id_mke = register_diag_field('ocean_model', 'MEKE_MKE', diag%axesT1, Time, & 'Surface mean (resolved) kinetic energy used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) CS%id_slope_z= register_diag_field('ocean_model', 'MEKE_slope_z', diag%axesT1, Time, & - 'Vertically averaged isopyncal slope magnitude used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) + 'Vertically averaged isopyncal slope magnitude used in MEKE', 'nondim', conversion=US%Z_to_L) CS%id_slope_x= register_diag_field('ocean_model', 'MEKE_slope_x', diag%axesCui, Time, & - 'Isopycnal slope in the x-direction used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) + 'Isopycnal slope in the x-direction used in MEKE', 'nondim', conversion=US%Z_to_L) CS%id_slope_y= register_diag_field('ocean_model', 'MEKE_slope_y', diag%axesCvi, Time, & - 'Isopycnal slope in the y-direction used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) - CS%id_rv= register_diag_field('ocean_model', 'MEKE_RV', diag%axesT1, Time, & - 'Surface relative vorticity used in MEKE', 'm2 s-2', conversion=US%L_T_to_m_s**2) + 'Isopycnal slope in the y-direction used in MEKE', 'nondim', conversion=US%Z_to_L) + CS%id_rv = register_diag_field('ocean_model', 'MEKE_RV', diag%axesT1, Time, & + 'Surface relative vorticity used in MEKE', 's-1', conversion=US%s_to_T) end subroutine ML_MEKE_init @@ -1567,35 +1576,38 @@ end subroutine ML_MEKE_init subroutine ML_MEKE_calculate_features(G, GV, US, CS, Rd_dx_h, u, v, tv, h, dt, features_array) type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MEKE_CS), intent(in) :: CS !< Control structure for MEKE - real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: Rd_dx_h !< Rossby radius of deformation over - !! the grid length scale [nondim] - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in ) :: Rd_dx_h !< Rossby radius of deformation over + !! the grid length scale [nondim] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(in) :: tv !< Type containing thermodynamic variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. - real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. + real, intent(in) :: dt !< Model(baroclinic) time-step [T ~> s]. real(kind=real32), dimension(SIZE(h),num_features), intent( out) :: features_array - !< The array of features needed for machine - !! learning inference - - real, dimension(SZI_(G),SZJ_(G)) :: mke - real, dimension(SZI_(G),SZJ_(G)) :: slope_z - real, dimension(SZIB_(G),SZJB_(G)) :: rv_z - real, dimension(SZIB_(G),SZJB_(G)) :: rv_z_t - real, dimension(SZI_(G),SZJ_(G)) :: rd_dx_z - - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)) :: h_u ! Thickness at u point - real, dimension(SZI_(G),SZJB_(G), SZK_(G)) :: h_v ! Thickness at v point - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: slope_x ! Isoneutral slope at U point - real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: slope_y ! Isoneutral slope at V point - real, dimension(SZIB_(G),SZJ_(G)) :: slope_x_vert_avg ! Isoneutral slope at U point - real, dimension(SZI_(G),SZJB_(G)) :: slope_y_vert_avg ! Isoneutral slope at V point + !< The array of features needed for machine + !! learning inference, with different units + !! for the various subarrays [various] + + real, dimension(SZI_(G),SZJ_(G)) :: mke ! Surface kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJ_(G)) :: slope_z ! Vertically averaged isoneutral slopes [Z L-1 ~> nondim] + real, dimension(SZIB_(G),SZJB_(G)) :: rv_z ! Surface relative vorticity [T-1 ~> s-1] + real, dimension(SZIB_(G),SZJB_(G)) :: rv_z_t ! Surface relative vorticity interpolated to tracer points [T-1 ~> s-1] + + real, dimension(SZIB_(G),SZJ_(G), SZK_(G)) :: h_u ! Thickness at u point [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJB_(G), SZK_(G)) :: h_v ! Thickness at v point [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1) :: slope_x ! Isoneutral slope at U point [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1) :: slope_y ! Isoneutral slope at V point [Z L-1 ~> nondim] + real, dimension(SZIB_(G),SZJ_(G)) :: slope_x_vert_avg ! Isoneutral slope at U point [Z L-1 ~> nondim] + real, dimension(SZI_(G),SZJB_(G)) :: slope_y_vert_avg ! Isoneutral slope at V point [Z L-1 ~> nondim] real, dimension(SZI_(G), SZJ_(G), SZK_(G)+1) :: e ! The interface heights relative to mean sea level [Z ~> m]. - real :: slope_t, u_t, v_t ! u and v interpolated to thickness point - real :: dvdx, dudy - real :: a_e, a_w, a_n, a_s, Idenom, sum_area + real :: slope_t ! Slope interpolated to thickness points [Z L-1 ~> nondim] + real :: u_t, v_t ! u and v interpolated to thickness points [L T-1 ~> m s-1] + real :: dvdx, dudy ! Components of relative vorticity [T-1 ~> s-1] + real :: a_e, a_w, a_n, a_s ! Fractional areas of neighboring cells for interpolating velocities [nondim] + real :: Idenom ! A normalizing factor in calculating weighted averages of areas [L-2 ~> m-2] + real :: sum_area ! A sum of adjacent cell areas [L2 ~> m2] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -1728,11 +1740,12 @@ end subroutine predict_MEKE !> Compute average of interface quantities weighted by the thickness of the surrounding layers real function vertical_average_interface(h, w, h_min) - real, dimension(:), intent(in) :: h !< Layer Thicknesses - real, dimension(:), intent(in) :: w !< Quantity to average - real, intent(in) :: h_min !< The vanishingly small layer thickness + real, dimension(:), intent(in) :: h !< Layer Thicknesses [H ~> m or kg m-2] + real, dimension(:), intent(in) :: w !< Quantity to average [arbitrary] + real, intent(in) :: h_min !< The vanishingly small layer thickness [H ~> m or kg m-2] - real :: htot, inv_htot + real :: htot ! Twice the sum of the layer thicknesses interpolated to interior interfaces [H ~> m or kg m-2] + real :: inv_htot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1] integer :: k, nk nk = size(h) @@ -1895,7 +1908,7 @@ end subroutine MEKE_end !! The local dissipation of \f$ E \f$ is parameterized through a linear !! damping, \f$\lambda\f$, and bottom drag, \f$ C_d | U_d | \gamma_b^2 \f$. !! The \f$ \gamma_b \f$ accounts for the weak projection of the column-mean -!! eddy velocty to the bottom. In other words, the bottom velocity is +!! eddy velocity to the bottom. In other words, the bottom velocity is !! estimated as \f$ \gamma_b U_e \f$. !! The bottom drag coefficient, \f$ C_d \f$ is the same as that used in the bottom !! friction in the mean model equations. diff --git a/src/parameterizations/lateral/MOM_MEKE_types.F90 b/src/parameterizations/lateral/MOM_MEKE_types.F90 index 57de7c0b02..e51f558ce3 100644 --- a/src/parameterizations/lateral/MOM_MEKE_types.F90 +++ b/src/parameterizations/lateral/MOM_MEKE_types.F90 @@ -26,8 +26,8 @@ module MOM_MEKE_types ! Parameters real :: KhTh_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTh [nondim] real :: KhTr_fac = 1.0 !< Multiplier to map Kh(MEKE) to KhTr [nondim]. - real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter. - real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter. + real :: backscatter_Ro_pow = 0.0 !< Power in Rossby number function for backscatter [nondim]. + real :: backscatter_Ro_c = 0.0 !< Coefficient in Rossby number function for backscatter [nondim]. end type MEKE_type diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 4339a699e5..e6dd131a99 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -52,7 +52,7 @@ module MOM_hor_visc logical :: better_bound_Ah !< If true, use a more careful bounding of the !! biharmonic viscosity to guarantee stability. real :: Re_Ah !! If nonzero, the biharmonic coefficient is scaled - !< so that the biharmonic Reynolds number is equal to this. + !< so that the biharmonic Reynolds number is equal to this [nondim]. real :: bound_coef !< The nondimensional coefficient of the ratio of !! the viscosity bounds to the theoretical maximum !! for stability without considering other terms [nondim]. @@ -123,8 +123,8 @@ module MOM_hor_visc real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & Kh_Max_xx, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. Ah_Max_xx, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. - n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points - n1n1_m_n2n2_h, & !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points + n1n2_h, & !< Factor n1*n2 in the anisotropic direction tensor at h-points [nondim] + n1n1_m_n2n2_h, & !< Factor n1**2-n2**2 in the anisotropic direction tensor at h-points [nondim] grid_sp_h2, & !< Harmonic mean of the squares of the grid [L2 ~> m2] grid_sp_h3 !< Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: Kh_bg_xy @@ -141,8 +141,8 @@ module MOM_hor_visc real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & Kh_Max_xy, & !< The maximum permitted Laplacian viscosity [L2 T-1 ~> m2 s-1]. Ah_Max_xy, & !< The maximum permitted biharmonic viscosity [L4 T-1 ~> m4 s-1]. - n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points - n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points + n1n2_q, & !< Factor n1*n2 in the anisotropic direction tensor at q-points [nondim] + n1n1_m_n2n2_q !< Factor n1**2-n2**2 in the anisotropic direction tensor at q-points [nondim] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & dx2h, & !< Pre-calculated dx^2 at h points [L2 ~> m2] @@ -181,10 +181,12 @@ module MOM_hor_visc type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostics - ! real, allocatable :: hf_diffu(:,:,:) ! Zonal hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. - ! real, allocatable :: hf_diffv(:,:,:) ! Merdional hor. visc. accel. x fract. thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffu(:,:,:) ! Zonal horizontal viscous acceleleration times + ! ! fractional thickness [L T-2 ~> m s-2]. + ! real, allocatable :: hf_diffv(:,:,:) ! Meridional horizontal viscous acceleleration times + ! ! fractional thickness [L T-2 ~> m s-2]. ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. - ! The code is retained for degugging purposes in the future. + ! The code is retained for debugging purposes in the future. integer :: num_smooth_gme !< number of smoothing passes for the GME fluxes. !>@{ @@ -242,34 +244,35 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !! of along-coordinate stress tensor [L T-2 ~> m s-2]. type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! related to Mesoscale Eddy Kinetic Energy. - type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control struct + type(hor_visc_CS), intent(in) :: CS !< Horizontal viscosity control structure type(ocean_OBC_type), optional, pointer :: OBC !< Pointer to an open boundary condition type - type(barotropic_CS), intent(in), optional :: BT !< Barotropic control struct - type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control struct + type(barotropic_CS), intent(in), optional :: BT !< Barotropic control structure + type(thickness_diffuse_CS), intent(in), optional :: TD !< Thickness diffusion control structure type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & - Del2u, & ! The u-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] + Del2u, & ! The u-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_u, & ! Thickness interpolated to u points [H ~> m or kg m-2]. vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dx, & ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - ubtav ! zonal barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] + ubtav ! zonal barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - Del2v, & ! The v-compontent of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] + Del2v, & ! The v-component of the Laplacian of velocity [L-1 T-1 ~> m-1 s-1] h_v, & ! Thickness interpolated to v points [H ~> m or kg m-2]. vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] div_xx_dy, & ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) [L-1 T-1 ~> m-1 s-1] - vbtav ! meridional barotropic vel. ave. over baroclinic time-step [L T-1 ~> m s-1] + vbtav ! meridional barotropic velocity averaged over a baroclinic time-step [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: & dudx_bt, dvdy_bt, & ! components in the barotropic horizontal tension [T-1 ~> s-1] div_xx, & ! Estimate of horizontal divergence at h-points [T-1 ~> s-1] sh_xx, & ! horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] sh_xx_bt, & ! barotropic horizontal tension (du/dx - dv/dy) including metric terms [T-1 ~> s-1] - str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] - str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xx,& ! str_xx is the diagonal term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2], but + ! at some points in the code it is not yet layer integrated, so is in [L2 T-2 ~> m2 s-2]. + str_xx_GME,& ! smoothed diagonal term in the stress tensor from GME [L2 T-2 ~> m2 s-2] bhstr_xx, & ! A copy of str_xx that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] FrictWorkIntz, & ! depth integrated energy dissipated by lateral friction [R L2 T-3 ~> W m-2] grad_vort_mag_h, & ! Magnitude of vorticity gradient at h-points [L-1 T-1 ~> m-1 s-1] @@ -288,8 +291,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, dvdx_bt, dudy_bt, & ! components in the barotropic shearing strain [T-1 ~> s-1] sh_xy, & ! horizontal shearing strain (du/dy + dv/dx) including metric terms [T-1 ~> s-1] sh_xy_bt, & ! barotropic horizontal shearing strain (du/dy + dv/dx) inc. metric terms [T-1 ~> s-1] - str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2] - str_xy_GME, & ! smoothed cross term in the stress tensor from GME [H L2 T-2 ~> m3 s-2 or kg s-2] + str_xy, & ! str_xy is the cross term in the stress tensor [H L2 T-2 ~> m3 s-2 or kg s-2], but + ! at some points in the code it is not yet layer integrated, so is in [L2 T-2 ~> m2 s-2]. + str_xy_GME, & ! smoothed cross term in the stress tensor from GME [L2 T-2 ~> m2 s-2] bhstr_xy, & ! A copy of str_xy that only contains the biharmonic contribution [H L2 T-2 ~> m3 s-2 or kg s-2] vort_xy, & ! Vertical vorticity (dv/dx - du/dy) including metric terms [T-1 ~> s-1] grad_vort_mag_q, & ! Magnitude of vorticity gradient at q-points [L-1 T-1 ~> m-1 s-1] @@ -310,9 +314,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, GME_coeff_q, & !< GME coeff. at q-points [L2 T-1 ~> m2 s-1] ShSt ! A diagnostic array of shear stress [T-1 ~> s-1]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & - KH_u_GME !< interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_u_GME !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & - KH_v_GME !< interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + KH_v_GME !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & Ah_h, & ! biharmonic viscosity at thickness points [L4 T-1 ~> m4 s-1] Kh_h, & ! Laplacian viscosity at thickness points [L2 T-1 ~> m2 s-1] @@ -324,7 +328,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & grid_Re_Kh, & ! Grid Reynolds number for Laplacian horizontal viscosity at h points [nondim] grid_Re_Ah, & ! Grid Reynolds number for Biharmonic horizontal viscosity at h points [nondim] - GME_coeff_h ! GME coeff. at h-points [L2 T-1 ~> m2 s-1] + GME_coeff_h ! GME coefficient at h-points [L2 T-1 ~> m2 s-1] real :: AhSm ! Smagorinsky biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: AhLth ! 2D Leith biharmonic viscosity [L4 T-1 ~> m4 s-1] real :: Shear_mag_bc ! Shear_mag value in backscatter [T-1 ~> s-1] @@ -342,17 +346,17 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: RoScl ! The scaling function for MEKE source term [nondim] real :: FatH ! abs(f) at h-point for MEKE source term [T-1 ~> s-1] real :: local_strain ! Local variable for interpolating computed strain rates [T-1 ~> s-1]. - real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE. Otherwise =1. + real :: meke_res_fn ! A copy of the resolution scaling factor if being applied to MEKE [nondim]. Otherwise = 1. real :: GME_coeff ! The GME (negative) viscosity coefficient [L2 T-1 ~> m2 s-1] real :: DY_dxBu ! Ratio of meridional over zonal grid spacing at vertices [nondim] - real :: DX_dyBu ! Ratio of zonal over meridiononal grid spacing at vertices [nondim] + real :: DX_dyBu ! Ratio of zonal over meridional grid spacing at vertices [nondim] real :: Sh_F_pow ! The ratio of shear over the absolute value of f raised to some power and rescaled [nondim] real :: backscat_subround ! The ratio of f over Shear_mag that is so small that the backscatter ! calculation gives the same value as if f were 0 [nondim]. real :: KE ! Local kinetic energy [L2 T-2 ~> m2 s-2] real :: d_del2u ! dy-weighted Laplacian(u) diff in x [L-2 T-1 ~> m-2 s-1] real :: d_del2v ! dx-weighted Laplacian(v) diff in y [L-2 T-1 ~> m-2 s-1] - real :: d_str ! Stress tensor update [H L2 T-2 ~> m3 s-2 or kg s-2] + real :: d_str ! Stress tensor update [L2 T-2 ~> m2 s-2] real :: grad_vort ! Vorticity gradient magnitude [L-1 T-1 ~> m-1 s-1] real :: grad_vort_qg ! QG-based vorticity gradient magnitude [L-1 T-1 ~> m-1 s-1] real :: grid_Kh ! Laplacian viscosity bound by grid [L2 T-1 ~> m2 s-1] @@ -365,7 +369,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, logical :: use_MEKE_Au integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: i, j, k, n - real :: inv_PI3, inv_PI2, inv_PI6 + real :: inv_PI3, inv_PI2, inv_PI6 ! Powers of the inverse of pi [nondim] ! Fields evaluated on active layers, used for constructing 3D stress fields ! NOTE: The position of these declarations can impact performance, due to the @@ -419,7 +423,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if ((rescale_Kh .or. CS%res_scale_MEKE) & .and. (.not. allocated(VarMix%Res_fn_h) .or. .not. allocated(VarMix%Res_fn_q))) & call MOM_error(FATAL, "MOM_hor_visc: VarMix%Res_fn_h and VarMix%Res_fn_q "//& - "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") + "both need to be associated with Resoln_scaled_Kh or RES_SCALE_MEKE_VISC.") elseif (CS%res_scale_MEKE) then call MOM_error(FATAL, "MOM_hor_visc: VarMix needs to be associated if "//& "RES_SCALE_MEKE_VISC is True.") @@ -430,7 +434,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%use_GME) then - ! initialize diag. array with zeros + ! Initialize diagnostic arrays with zeros GME_coeff_h(:,:,:) = 0.0 GME_coeff_q(:,:,:) = 0.0 str_xx_GME(:,:) = 0.0 @@ -1418,11 +1422,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, call smooth_GME(CS, G, GME_flux_h=str_xx_GME) call smooth_GME(CS, G, GME_flux_q=str_xy_GME) + ! This changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo - ! GME is applied below + ! This adds in GME and changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. if (CS%no_slip) then do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * CS%reduction_xy(I,J)) @@ -1434,10 +1439,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif else ! .not. use_GME + ! This changes the units of str_xx from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = str_xx(i,j) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo + ! This changes the units of str_xy from [L2 T-2 ~> m2 s-2] to [H L2 T-2 ~> m3 s-2 or kg s-2]. if (CS%no_slip) then do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = str_xy(I,J) * (hq(I,J) * CS%reduction_xy(I,J)) @@ -1682,13 +1689,12 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< Structure to regulate diagnostic output. - type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure type(accel_diag_ptrs), intent(in), optional :: ADp !< Acceleration diagnostics - real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v - real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v - ! u0v is the Laplacian sensitivities to the v velocities - ! at u points [L-2 ~> m-2], with u0u, v0u, and v0v defined similarly. + ! u0v is the Laplacian sensitivities to the v velocities at u points, with u0u, v0u, and v0v defined analogously. + real, dimension(SZIB_(G),SZJ_(G)) :: u0u, u0v ! Laplacian sensitivities at u points [L-2 ~> m-2] + real, dimension(SZI_(G),SZJB_(G)) :: v0u, v0v ! Laplacian sensitivities at v points [L-2 ~> m-2] real :: grid_sp_h2 ! Harmonic mean of the squares of the grid [L2 ~> m2] real :: grid_sp_h3 ! Harmonic mean of the squares of the grid^(3/2) [L3 ~> m3] real :: grid_sp_q2 ! spacings at h and q points [L2 ~> m2] @@ -1705,22 +1711,22 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) ! grid spacing, to limit biharmonic viscosity real :: Kh ! Lapacian horizontal viscosity [L2 T-1 ~> m2 s-1] real :: Ah ! biharmonic horizontal viscosity [L4 T-1 ~> m4 s-1] - real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Lap visc - real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives bih visc + real :: Kh_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing gives Laplacian viscosity + real :: Ah_vel_scale ! this speed [L T-1 ~> m s-1] times grid spacing cubed gives biharmonic viscosity real :: Ah_time_scale ! damping time-scale for biharmonic visc [T ~> s] - real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant - real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant - real :: Leith_Lap_const ! nondimensional Laplacian Leith constant - real :: Leith_bi_const ! nondimensional biharmonic Leith constant + real :: Smag_Lap_const ! nondimensional Laplacian Smagorinsky constant [nondim] + real :: Smag_bi_const ! nondimensional biharmonic Smagorinsky constant [nondim] + real :: Leith_Lap_const ! nondimensional Laplacian Leith constant [nondim] + real :: Leith_bi_const ! nondimensional biharmonic Leith constant [nondim] real :: dt ! The dynamics time step [T ~> s] real :: Idt ! The inverse of dt [T-1 ~> s-1] - real :: denom ! work variable; the denominator of a fraction - real :: maxvel ! largest permitted velocity components [m s-1] + real :: denom ! work variable; the denominator of a fraction [L-2 ~> m-2] or [L-4 ~> m-4] + real :: maxvel ! largest permitted velocity components [L T-1 ~> m s-1] real :: bound_Cor_vel ! grid-scale velocity variations at which value ! the quadratically varying biharmonic viscosity ! balances Coriolis acceleration [L T-1 ~> m s-1] real :: Kh_sin_lat ! Amplitude of latitudinally dependent viscosity [L2 T-1 ~> m2 s-1] - real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat + real :: Kh_pwr_of_sine ! Power used to raise sin(lat) when using Kh_sin_lat [nondim] logical :: bound_Cor_def ! parameter setting of BOUND_CORIOLIS logical :: split ! If true, use the split time stepping scheme. ! If false and USE_GME = True, issue a FATAL error. @@ -1730,10 +1736,11 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) ! forms of the same expressions. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags - character(len=64) :: inputdir, filename - real :: deg2rad ! Converts degrees to radians - real :: slat_fn ! sin(lat)**Kh_pwr_of_sine - real :: aniso_grid_dir(2) ! Vector (n1,n2) for anisotropic direction + character(len=200) :: inputdir, filename ! Input file names and paths + character(len=80) :: Kh_var ! Input variable names + real :: deg2rad ! Converts degrees to radians [radians degree-1] + real :: slat_fn ! sin(lat)**Kh_pwr_of_sine [nondim] + real :: aniso_grid_dir(2) ! Vector (n1,n2) for anisotropic direction [nondim] integer :: aniso_mode ! Selects the mode for setting the anisotropic direction integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -1851,24 +1858,24 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) units="m2 s-1", default=0.0, scale=US%m_to_L**2*US%T_to_s, & do_not_log=.not.CS%anisotropic) call get_param(param_file, mdl, "ANISOTROPIC_MODE", aniso_mode, & - "Selects the mode for setting the direction of anistropy.\n"//& + "Selects the mode for setting the direction of anisotropy.\n"//& "\t 0 - Points along the grid i-direction.\n"//& "\t 1 - Points towards East.\n"//& "\t 2 - Points along the flow direction, U/|U|.", & default=0, do_not_log=.not.CS%anisotropic) if (aniso_mode == 0) then call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "The vector pointing in the direction of anisotropy for horizontal viscosity. "//& "n1,n2 are the i,j components relative to the grid.", & units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) elseif (aniso_mode == 1) then call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for horizontal viscosity. "//& + "The vector pointing in the direction of anisotropy for horizontal viscosity. "//& "n1,n2 are the i,j components relative to the spherical coordinates.", & units="nondim", fail_if_missing=CS%anisotropic, do_not_log=.not.CS%anisotropic) else call get_param(param_file, mdl, "ANISO_GRID_DIR", aniso_grid_dir, & - "The vector pointing in the direction of anistropy for horizontal viscosity.", & + "The vector pointing in the direction of anisotropy for horizontal viscosity.", & units="nondim", fail_if_missing=.false., do_not_log=.true.) endif @@ -1929,8 +1936,14 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & "If true, use QG Leith nonlinear eddy viscosity.", & default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + if (CS%use_QG_Leith_visc) then + call MOM_error(FATAL, "USE_QG_LEITH_VISC=True activates code that is a work-in-progress and "//& + "should not be used until a number of bugs are fixed. Specifically it does not "//& + "reproduce across PE count or layout, and may use arrays that have not been properly "//& + "set or allocated. See github.com/mom-ocean/MOM6/issues/1590 for a discussion.") + endif if (CS%use_QG_Leith_visc .and. .not. (CS%Leith_Kh .or. CS%Leith_Ah) ) then - call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& + call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& "LEITH_KH or LEITH_AH must be True when USE_QG_LEITH_VISC=True.") endif @@ -1944,12 +1957,13 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def, & do_not_log=.not.CS%Smagorinsky_Ah) if (.not.CS%Smagorinsky_Ah) CS%bound_Coriolis = .false. - call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) + call get_param(param_file, mdl, "MAXVEL", maxvel, & + units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & "The velocity scale at which BOUND_CORIOLIS_BIHARM causes "//& "the biharmonic drag to have comparable magnitude to the "//& "Coriolis acceleration. The default is set by MAXVEL.", & - units="m s-1", default=maxvel, scale=US%m_s_to_L_T, & + units="m s-1", default=maxvel*US%L_T_to_m_s, scale=US%m_s_to_L_T, & do_not_log=.not.(CS%Smagorinsky_Ah .and. CS%bound_Coriolis)) call get_param(param_file, mdl, "LEITH_BI_CONST", Leith_bi_const, & @@ -1994,7 +2008,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) if (CS%use_GME) then call get_param(param_file, mdl, "GME_NUM_SMOOTHINGS", CS%num_smooth_gme, & "Number of smoothing passes for the GME fluxes.", & - units="nondim", default=1) + default=1) call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & "The strength of GME tapers quadratically to zero when the bathymetric "//& "depth is shallower than GME_H0.", & @@ -2074,11 +2088,15 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & 'The filename containing a 2d map of "Kh".', & default='KH_background_2d.nc', do_not_log=.not.CS%use_Kh_bg_2d) + call get_param(param_file, mdl, "KH_BG_2D_VARNAME", Kh_var, & + 'The name in the input file of the horizontal viscosity variable.', & + default='Kh', do_not_log=.not.CS%use_Kh_bg_2d) + if (CS%use_Kh_bg_2d) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 - call MOM_read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & + call MOM_read_data(trim(inputdir)//trim(filename), Kh_var, CS%Kh_bg_2d, & G%domain, timelevel=1, scale=US%m_to_L**2*US%T_to_s) call pass_var(CS%Kh_bg_2d, G%domain) endif @@ -2224,8 +2242,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) CS%Idxdy2v(i,J) = G%IdxCv(i,J) * (G%IdyCv(i,J)*G%IdyCv(i,J)) enddo ; enddo CS%Ah_bg_xy(:,:) = 0.0 - ! The 0.3 below was 0.4 in MOM1.10. The change in hq requires - ! this to be less than 1/3, rather than 1/2 as before. + ! The 0.3 below was 0.4 in HIM 1.10. The change in hq requires + ! this to be less than 1/3, rather than 1/2 as before. if (CS%better_bound_Ah .or. CS%bound_Ah) Ah_Limit = 0.3 / (dt*64.0) if (CS%Smagorinsky_Ah .and. CS%bound_Coriolis) & BoundCorConst = 1.0 / (5.0*(bound_Cor_vel*bound_Cor_vel)) @@ -2528,10 +2546,10 @@ subroutine align_aniso_tensor_to_grid(CS, n1, n2) real, intent(in) :: n1 !< i-component of direction vector [nondim] real, intent(in) :: n2 !< j-component of direction vector [nondim] ! Local variables - real :: recip_n2_norm + real :: recip_n2_norm ! The inverse of the squared magnitude of n1 and n2 [nondim] ! For normalizing n=(n1,n2) in case arguments are not a unit vector recip_n2_norm = n1**2 + n2**2 - if (recip_n2_norm > 0.) recip_n2_norm = 1./recip_n2_norm + if (recip_n2_norm > 0.) recip_n2_norm = 1. / recip_n2_norm CS%n1n2_h(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm CS%n1n2_q(:,:) = 2. * ( n1 * n2 ) * recip_n2_norm CS%n1n1_m_n2n2_h(:,:) = ( n1 * n1 - n2 * n2 ) * recip_n2_norm @@ -2544,13 +2562,13 @@ subroutine smooth_GME(CS, G, GME_flux_h, GME_flux_q) type(hor_visc_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< GME diffusive flux - !! at h points + !! at h points [L2 T-2 ~> m2 s-2] real, dimension(SZIB_(G),SZJB_(G)), optional, intent(inout) :: GME_flux_q!< GME diffusive flux - !! at q points + !! at q points [L2 T-2 ~> m2 s-2] ! local variables - real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original - real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original - real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real, dimension(SZI_(G),SZJ_(G)) :: GME_flux_h_original ! The previous value of GME_flux_h [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original ! The previous value of GME_flux_q [L2 T-2 ~> m2 s-2] + real :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] integer :: i, j, s, halosz integer :: xh, xq ! The number of valid extra halo points for h and q points. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -2613,7 +2631,7 @@ end subroutine smooth_GME !> Deallocates any variables allocated in hor_visc_init. subroutine hor_visc_end(CS) - type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control struct + type(hor_visc_CS), intent(inout) :: CS !< Horizontal viscosity control structure if (CS%Laplacian .or. CS%biharmonic) then DEALLOC_(CS%dx2h) ; DEALLOC_(CS%dx2q) ; DEALLOC_(CS%dy2h) ; DEALLOC_(CS%dy2q) DEALLOC_(CS%dx_dyT) ; DEALLOC_(CS%dy_dxT) ; DEALLOC_(CS%dx_dyBu) ; DEALLOC_(CS%dy_dxBu) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index b152583269..6dda4c1b1c 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -64,9 +64,9 @@ module MOM_internal_tides !! is possible (i.e. ridge cells) ! (could be in G control structure) real, allocatable, dimension(:,:) :: trans - !< partial transmission coeff for each "coast cell" + !< partial transmission coeff for each "coast cell" [nondim] real, allocatable, dimension(:,:) :: residual - !< residual of reflection and transmission coeff for each "coast cell" + !< residual of reflection and transmission coeff for each "coast cell" [nondim] real, allocatable, dimension(:,:,:,:) :: cp !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss @@ -83,7 +83,7 @@ module MOM_internal_tides !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss !< internal tide energy loss due to the residual at slopes [R Z3 T-3 ~> W m-2] - real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, + real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc background processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] @@ -113,6 +113,8 @@ module MOM_internal_tides !< If true, apply scattering due to small-scale roughness as a sink. logical :: apply_Froude_drag !< If true, apply wave breaking as a sink. + real :: En_check_tol !< An energy density tolerance for flagging points with an imbalance in the + !! internal tide energy budget when apply_Froude_drag is True [R Z3 T-2 ~> J m-2] logical :: apply_residual_drag !< If true, apply sink from residual term of reflection/transmission. real, allocatable :: En(:,:,:,:,:) @@ -124,7 +126,7 @@ module MOM_internal_tides type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(wave_structure_CS) :: wave_struct !< Wave structure control struct + type(wave_structure_CS) :: wave_struct !< Wave structure control structure !>@{ Diag handles ! Diag handles relevant to all modes, frequencies, and angles @@ -135,14 +137,14 @@ module MOM_internal_tides ! Diag handles considering: sums over all modes, frequencies, and angles integer :: id_tot_leak_loss = -1, id_tot_quad_loss = -1, id_tot_itidal_loss = -1 integer :: id_tot_Froude_loss = -1, id_tot_residual_loss = -1, id_tot_allprocesses_loss = -1 - ! Diag handles considering: all modes & freqs; summed over angles + ! Diag handles considering: all modes & frequencies; summed over angles integer, allocatable, dimension(:,:) :: & id_En_mode, & id_itidal_loss_mode, & id_allprocesses_loss_mode, & id_Ub_mode, & id_cp_mode - ! Diag handles considering: all modes, freqs, and angles + ! Diag handles considering: all modes, frequencies, and angles integer, allocatable, dimension(:,:) :: & id_En_ang_mode, & id_itidal_loss_ang_mode @@ -177,13 +179,13 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Length of time over which to advance !! the internal tides [T ~> s]. - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure real, dimension(SZI_(G),SZJ_(G),CS%nMode), & intent(in) :: cn !< The internal wave speeds of each !! mode [L T-1 ~> m s-1]. ! Local variables real, dimension(SZI_(G),SZJ_(G),2) :: & - test + test ! A test unit vector used to determine grid rotation in halos [nondim] real, dimension(SZI_(G),SZJ_(G),CS%nFreq,CS%nMode) :: & tot_En_mode, & ! energy summed over angles only [R Z3 T-2 ~> J m-2] Ub, & ! near-bottom horizontal velocity of wave (modal) [L T-1 ~> m s-1] @@ -194,15 +196,18 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! 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] - real :: frac_per_sector, f2, Kmag2 + itidal_loss_mode, & ! Energy lost due to small-scale wave drag, summed over angles [R Z3 T-3 ~> W m-2] + allprocesses_loss_mode ! Total energy loss rates for a given mode and frequency (summed over + ! all angles) [R Z3 T-3 ~> W m-2] + real :: frac_per_sector ! The inverse of the number of angular, modal and frequency bins [nondim] + real :: f2 ! The squared Coriolis parameter interpolated to a tracer point [T-2 ~> s-2] + real :: Kmag2 ! A squared horizontal wavenumber [L-2 ~> m-2] real :: I_D_here ! The inverse of the local depth [Z-1 ~> m-1] - real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] - real :: freq2 ! The frequency squared [T-2 ~> s-2] - real :: c_phase ! The phase speed [L T-1 ~> m s-1] + real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] + real :: freq2 ! The frequency squared [T-2 ~> s-2] + real :: c_phase ! The phase speed [L T-1 ~> m s-1] real :: loss_rate ! An energy loss rate [T-1 ~> s-1] - real :: Fr2_max + real :: Fr2_max ! The column maximum internal wave Froude number squared [nondim] real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] real :: en_subRO ! A tiny energy to prevent division by zero [R Z3 T-2 ~> J m-2] real :: En_new, En_check ! Energies for debugging [R Z3 T-2 ~> J m-2] @@ -221,7 +226,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & cn_subRO = 1e-30*US%m_s_to_L_T en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T - ! init local arrays + ! initialize local arrays drag_scale(:,:) = 0. Ub(:,:,:,:) = 0. @@ -474,7 +479,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Re-scale (reduce) energy due to breaking CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m)/Fr2_max ! Check (for debugging only) - if (abs(En_new - En_check) > 1e-10*US%kg_m3_to_R*US%m_to_Z**3*US%T_to_s**2) then + if (abs(En_new - En_check) > CS%En_check_tol) then call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr-breaking.", & all_print=.true.) write(mesg,*) "En_new=", En_new , "En_check=", En_check @@ -485,7 +490,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & Delta_E_check = En_initial - sum(CS%En(i,j,:,fr,m)) TKE_Froude_loss_check = abs(Delta_E_check)/dt TKE_Froude_loss_tot = sum(CS%TKE_Froude_loss(i,j,:,fr,m)) - if (abs(TKE_Froude_loss_check - TKE_Froude_loss_tot) > 1e-10) then + if (abs(TKE_Froude_loss_check - TKE_Froude_loss_tot)*dt > CS%En_check_tol) then call MOM_error(WARNING, "MOM_internal_tides: something is wrong with Fr energy update.", & all_print=.true.) write(mesg,*) "TKE_Froude_loss_check=", TKE_Froude_loss_check, & @@ -540,13 +545,13 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call enable_averages(dt, time_end, CS%diag) if (query_averaging_enabled(CS%diag)) then - ! Output two-dimensional diagnostistics + ! Output two-dimensional diagnostics if (CS%id_tot_En > 0) call post_data(CS%id_tot_En, tot_En, CS%diag) if (CS%id_itide_drag > 0) call post_data(CS%id_itide_drag, drag_scale, CS%diag) if (CS%id_TKE_itidal_input > 0) call post_data(CS%id_TKE_itidal_input, & TKE_itidal_input, CS%diag) - ! Output 2-D energy density (summed over angles) for each freq and mode + ! Output 2-D energy density (summed over angles) for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_En_mode(fr,m) > 0) then tot_En(:,:) = 0.0 do a=1,CS%nAngle ; do j=js,je ; do i=is,ie @@ -555,7 +560,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_En_mode(fr,m), tot_En, CS%diag) endif ; enddo ; enddo - ! Output 3-D (i,j,a) energy density for each freq and mode + ! Output 3-D (i,j,a) energy density for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_En_ang_mode(fr,m) > 0) then call post_data(CS%id_En_ang_mode(fr,m), CS%En(:,:,:,fr,m) , CS%diag) endif ; enddo ; enddo @@ -604,7 +609,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_tot_allprocesses_loss, tot_allprocesses_loss, CS%diag) endif - ! Output 2-D energy loss (summed over angles) for each freq and mode + ! Output 2-D energy loss (summed over angles) for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq if (CS%id_itidal_loss_mode(fr,m) > 0 .or. CS%id_allprocesses_loss_mode(fr,m) > 0) then itidal_loss_mode(:,:) = 0.0 ! wave-drag processes (could do others as well) @@ -620,17 +625,17 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & call post_data(CS%id_allprocesses_loss_mode(fr,m), allprocesses_loss_mode, CS%diag) endif ; enddo ; enddo - ! Output 3-D (i,j,a) energy loss for each freq and mode + ! Output 3-D (i,j,a) energy loss for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_itidal_loss_ang_mode(fr,m) > 0) then call post_data(CS%id_itidal_loss_ang_mode(fr,m), CS%TKE_itidal_loss(:,:,:,fr,m) , CS%diag) endif ; enddo ; enddo - ! Output 2-D period-averaged horizontal near-bottom mode velocity for each freq and mode + ! Output 2-D period-averaged horizontal near-bottom mode velocity for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_Ub_mode(fr,m) > 0) then call post_data(CS%id_Ub_mode(fr,m), Ub(:,:,fr,m), CS%diag) endif ; enddo ; enddo - ! Output 2-D horizontal phase velocity for each freq and mode + ! Output 2-D horizontal phase velocity for each frequency and mode do m=1,CS%NMode ; do fr=1,CS%Nfreq ; if (CS%id_cp_mode(fr,m) > 0) then call post_data(CS%id_cp_mode(fr,m), CS%cp(:,:,fr,m), CS%diag) endif ; enddo ; enddo @@ -645,16 +650,17 @@ end subroutine propagate_int_tide subroutine sum_En(G, US, CS, En, label) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), & intent(in) :: En !< The energy density of the internal tides [R Z3 T-2 ~> J m-2]. character(len=*), intent(in) :: label !< A label to use in error messages ! Local variables real :: En_sum ! The total energy in MKS units for potential output [J] integer :: a - ! real :: En_sum_diff, En_sum_pdiff + ! real :: En_sum_diff ! Change in energy from the expected value [J] + ! real :: En_sum_pdiff ! Percentage change in energy from the expected value [nondim] ! character(len=160) :: mesg ! The text of an error message - ! real :: days + ! real :: days ! The time in days for use in output messages [days] En_sum = 0.0 do a=1,CS%nAngle @@ -684,7 +690,7 @@ end subroutine sum_En subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & @@ -700,16 +706,16 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, !! (q*rho*kappa*h^2*N*U^2). real, intent(in) :: dt !< Time increment [T ~> s]. logical,optional, intent(in) :: full_halos !< If true, do the calculation over the - !! entirecomputational domain. + !! entire computational domain. ! Local variables integer :: j,i,m,fr,a, is, ie, js, je real :: En_tot ! energy for a given mode, frequency, and point summed over angles [R Z3 T-2 ~> J m-2] real :: TKE_loss_tot ! dissipation for a given mode, frequency, and point summed over angles [R Z3 T-3 ~> W m-2] - real :: frac_per_sector ! fraction of energy in each wedge + real :: frac_per_sector ! fraction of energy in each wedge [nondim] real :: q_itides ! fraction of energy actually lost to mixing (remainder, 1-q, is - ! assumed to stay in propagating mode for now - BDM) + ! assumed to stay in propagating mode for now - BDM) [nondim] real :: loss_rate ! approximate loss rate for implicit calc [T-1 ~> s-1] - real :: En_negl ! negilibly small number to prevent division by zero + real :: En_negl ! negligibly small number to prevent division by zero [R Z3 T-2 ~> J m-2] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -753,7 +759,7 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, ! if (TKE_loss(i,j,a,fr,m)*dt <= En(i,j,a,fr,m))then ! En(i,j,a,fr,m) = En(i,j,a,fr,m) - TKE_loss(i,j,a,fr,m)*dt ! else - ! call MOM_error(WARNING, "itidal_lowmode_loss: energy loss greater than avalable, "// & + ! call MOM_error(WARNING, "itidal_lowmode_loss: energy loss greater than available, "// & ! " setting En to zero.", all_print=.true.) ! En(i,j,a,fr,m) = 0.0 ! endif @@ -775,7 +781,7 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) integer, intent(in) :: i !< The i-index of the value to be reported. integer, intent(in) :: j !< The j-index of the value to be reported. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure character(len=*), intent(in) :: mechanism !< The named mechanism of loss to return real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified !! mechanism [R Z3 T-3 ~> W m-2]. @@ -806,29 +812,33 @@ subroutine refract(En, cn, freq, dt, G, US, NAngle, use_PPMang) ! Local variables integer, parameter :: stencil = 2 real, dimension(SZI_(G),1-stencil:NAngle+stencil) :: & - En2d + En2d ! The internal gravity wave energy density in zonal slices [R Z3 T-2 ~> J m-2] real, dimension(1-stencil:NAngle+stencil) :: & - cos_angle, sin_angle + cos_angle, sin_angle ! The cosine and sine of each angle [nondim] real, dimension(SZI_(G)) :: & - Dk_Dt_Kmag, Dl_Dt_Kmag + Dk_Dt_Kmag, Dl_Dt_Kmag ! Rates of angular refraction [T-1 ~> s-1] real, dimension(SZI_(G),0:nAngle) :: & - Flux_E + Flux_E ! The flux of energy between successive angular wedges within a timestep [R Z3 T-2 ~> J m-2] 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 + CFL_ang ! The CFL number of angular refraction [nondim] + real, dimension(G%IsdB:G%IedB,G%jsd:G%jed) :: cn_u !< Internal wave group velocity at U-point [L T-1 ~> m s-1] + real, dimension(G%isd:G%ied,G%JsdB:G%JedB) :: cn_v !< Internal wave group velocity at V-point [L T-1 ~> m s-1] + real, dimension(G%isd:G%ied,G%jsd:G%jed) :: cnmask !< Local mask for group velocity [nondim] real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. real :: favg ! The average Coriolis parameter at a point [T-1 ~> s-1]. real :: df_dy, df_dx ! The x- and y- gradients of the Coriolis parameter [T-1 L-1 ~> s-1 m-1]. real :: dlnCn_dx ! The x-gradient of the wave speed divided by itself [L-1 ~> m-1]. real :: dlnCn_dy ! The y-gradient of the wave speed divided by itself [L-1 ~> m-1]. - real :: Angle_size, dt_Angle_size, angle - real :: Ifreq, Kmag2, I_Kmag + real :: Angle_size ! The size of each wedge of angles [rad] + real :: dt_Angle_size ! The time step divided by the angle size [T rad-1 ~> s rad-1] + real :: angle ! The central angle of each wedge [rad] + real :: Ifreq ! The inverse of the wave frequency [T ~> s] + real :: Kmag2 ! A squared horizontal wavenumber [L-2 ~> m-2] + real :: I_Kmag ! The inverse of the magnitude of the horizontal wavenumber [L ~> m] 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 + real :: wgt1, wgt2 ! Weights in an average, both of which may be 0 [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; na = size(En,3) asd = 1-stencil ; aed = NAngle+stencil @@ -936,21 +946,21 @@ end subroutine refract !! piecewise parabolic scheme. This needs to be called from within i and j spatial loops. subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer, intent(in) :: NAngle !< The number of wave orientations in the - !! discretized wave energy spectrum. + !! discretized wave energy spectrum [nondim] real, intent(in) :: dt !< Time increment [T ~> s]. integer, intent(in) :: halo_ang !< The halo size in angular space real, dimension(1-halo_ang:NAngle+halo_ang), & intent(in) :: En2d !< The internal gravity wave energy density as a !! function of angular resolution [R Z3 T-2 ~> J m-2]. real, dimension(1-halo_ang:NAngle+halo_ang), & - intent(in) :: CFL_ang !< The CFL number of the energy advection across angles + intent(in) :: CFL_ang !< The CFL number of the energy advection across angles [nondim] real, dimension(0:NAngle), intent(out) :: Flux_En !< The time integrated internal wave energy flux !! across angles [R Z3 T-2 ~> J m-2]. ! Local variables - real :: flux + real :: flux ! The internal wave energy flux across angles [R Z3 T-3 ~> W m-2]. real :: u_ang ! Angular propagation speed [Rad T-1 ~> Rad s-1] real :: Angle_size ! The size of each orientation wedge in radians [Rad] - real :: I_Angle_size ! The inverse of the the orientation wedges [Rad-1] + real :: I_Angle_size ! The inverse of the orientation wedges [Rad-1] real :: I_dt ! The inverse of the timestep [T-1 ~> s-1] real :: aR, aL ! Left and right edge estimates of energy density [R Z3 T-2 rad-1 ~> J m-2 rad-1] real :: Ep, Ec, Em ! Mean angular energy density for three successive wedges in angular @@ -1037,7 +1047,7 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss) real, intent(in) :: freq !< Wave frequency [T-1 ~> s-1]. real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & intent(inout) :: residual_loss !< internal tide energy loss due !! to the residual at slopes [R Z3 T-3 ~> W m-2]. @@ -1050,11 +1060,16 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss) real, dimension(SZI_(G),SZJB_(G)) :: & speed_y ! The magnitude of the group velocity at the Cv points [L T-1 ~> m s-1]. real, dimension(0:NAngle) :: & - cos_angle, sin_angle + cos_angle, sin_angle ! The cosine and sine of each angle [nondim] real, dimension(NAngle) :: & - Cgx_av, Cgy_av, dCgx, dCgy + Cgx_av, & ! The average projection of the wedge into the x-direction [nondim] + Cgy_av, & ! The average projection of the wedge into the y-direction [nondim] + dCgx, & ! The difference in x-projections between the edges of each angular band [nondim]. + dCgy ! The difference in y-projections between the edges of each angular band [nondim]. real :: f2 ! The squared Coriolis parameter [T-2 ~> s-2]. - real :: Angle_size, I_Angle_size, angle + real :: Angle_size ! The size of each wedge of angles [rad] + real :: I_Angle_size ! The inverse of the size of each wedge of angles [rad-1] + real :: angle ! The central angle of each wedge [rad] real :: Ifreq ! The inverse of the frequency [T ~> s] real :: freq2 ! The frequency squared [T-2 ~> s-2] type(loop_bounds_type) :: LB @@ -1166,30 +1181,36 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. real, intent(in) :: dt !< Time increment [T ~> s]. - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables integer :: i, j, ish, ieh, jsh, jeh, m - real :: TwoPi, Angle_size - real :: energized_angle ! angle through center of current wedge - real :: theta ! angle at edge of wedge - real :: Nsubrays ! number of sub-rays for averaging + real :: TwoPi ! The radius of the circumference of a circle to its radius [nondim] + real :: Angle_size ! The size of each angular wedge [radians] + real :: energized_angle ! angle through center of current wedge [radians] + real :: theta ! angle at edge of each sub-wedge [radians] + real :: Nsubrays ! number of sub-rays for averaging [nondim] ! count includes the two rays that bound the current wedge, ! i.e. those at -dtheta/2 and +dtheta/2 from energized angle - real :: I_Nsubwedges ! inverse of number of sub-wedges - real :: cos_thetaDT, sin_thetaDT ! cos(theta)*dt, sin(theta)*dt - real :: xNE,xNW,xSW,xSE,yNE,yNW,ySW,ySE ! corner point coordinates of advected fluid parcel - real :: CFL_xNE,CFL_xNW,CFL_xSW,CFL_xSE,CFL_yNE,CFL_yNW,CFL_ySW,CFL_ySE,CFL_max - real :: xN,xS,xE,xW,yN,yS,yE,yW ! intersection point coordinates of parcel edges and grid - real :: xCrn,yCrn ! grid point contained within advected fluid parcel - real :: xg,yg ! grid point of interest - real :: slopeN,slopeW,slopeS,slopeE, bN,bW,bS,bE ! parameters defining parcel sides - real :: aNE,aN,aNW,aW,aSW,aS,aSE,aE,aC ! sub-areas of advected parcel - real :: a_total ! total area of advected parcel - ! real :: a1,a2,a3,a4 ! areas used in calculating polygon areas (sub-areas) of advected parcel - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: x,y ! coordinates of cell corners - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: Idx,Idy ! inverse of dx,dy at cell corners - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: dx,dy ! dx,dy at cell corners + real :: I_Nsubwedges ! inverse of number of sub-wedges [nondim] + real :: cos_thetaDT, sin_thetaDT ! cos(theta)*dt, sin(theta)*dt [T ~> s] + real :: xNE, xNW, xSW, xSE ! corner point x-coordinates of advected fluid parcel [L ~> m] + real :: yNE, yNW, ySW, ySE ! corner point y-coordinates of advected fluid parcel [L ~> m] + real :: CFL_xNE, CFL_xNW, CFL_xSW, CFL_xSE ! Various x-direction CFL numbers for propagation [nondim] + real :: CFL_yNE, CFL_yNW, CFL_ySW, CFL_ySE ! Various y-direction CFL numbers for propagation [nondim] + real :: CFL_max ! The maximum of the x- and y-CFL numbers for propagation [nondim] + real :: xN, xS, xE, xW ! intersection point x-coordinates of parcel edges and grid [L ~> m] + real :: yN, yS, yE, yW ! intersection point y-coordinates of parcel edges and grid [L ~> m] + real :: xCrn, yCrn ! Coordinates of grid point contained within advected fluid parcel [L ~> m] + real :: xg, yg ! Positions of grid point of interest [L ~> m] + real :: slopeN, slopeW, slopeS, slopeE ! Coordinate-space slopes of parcel sides [nondim] + real :: bN, bW, bS, bE ! parameters defining parcel sides [L ~> m] + real :: aNE, aN, aNW, aW, aSW, aS, aSE, aE, aC ! sub-areas of advected parcel [L2 ~> m2] + real :: a_total ! total area of advected parcel [L2 ~> m2] + ! real :: a1,a2,a3,a4 ! areas used in calculating polygon areas (sub-areas) of advected parcel [L2 ~> m2] + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: x, y ! coordinates of cell corners [L ~> m] + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: Idx, Idy ! inverse of dx,dy at cell corners [L-1 ~> m-1] + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed) :: dx, dy ! dx,dy at cell corners [L ~> m] real, dimension(2) :: E_new ! Energy in cell after advection for subray [R Z3 T-2 ~> J m-2]; set size ! here to define Nsubrays - this should be made an input option later! @@ -1447,12 +1468,12 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & intent(in) :: speed_x !< The magnitude of the group velocity at the !! Cu points [L T-1 ~> m s-1]. - real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band. + real, dimension(Nangle), intent(in) :: Cgx_av !< The average x-projection in each angular band [nondim] real, dimension(Nangle), intent(in) :: dCgx !< The difference in x-projections between the - !! edges of each angular band. + !! edges of each angular band [nondim]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: residual_loss !< internal tide energy loss due @@ -1463,8 +1484,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res real, dimension(SZIB_(G),SZJ_(G)) :: & flux_x ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(SZIB_(G)) :: & - cg_p, flux1 - !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p + cg_p, & ! The x-direction group velocity [L T-1 ~> m s-1] + flux1 ! A 1-d copy of the x-direction internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & Fdt_m, Fdt_p! Left and right energy fluxes [R Z3 L2 T-2 ~> J] integer :: i, j, ish, ieh, jsh, jeh, a @@ -1533,7 +1554,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, res !! edges of each angular band. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & intent(inout) :: residual_loss !< internal tide energy loss due @@ -1543,8 +1564,9 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, res EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. real, dimension(SZI_(G),SZJB_(G)) :: & flux_y ! The internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. - real, dimension(SZI_(G)) :: cg_p, flux1 - !real, dimension(SZI_(G),SZJB_(G),Nangle) :: En_m, En_p + real, dimension(SZI_(G)) :: & + cg_p, & ! The y-direction group velocity [L T-1 ~> m s-1] + flux1 ! A 1-d copy of the y-direction internal wave energy flux [R Z3 L2 T-3 ~> J s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle) :: & Fdt_m, Fdt_p! South and north energy fluxes [R Z3 L2 T-2 ~> J] integer :: i, j, ish, ieh, jsh, jeh, a @@ -1699,7 +1721,7 @@ subroutine reflect(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables @@ -1806,7 +1828,7 @@ subroutine teleport(En, NAngle, CS, G, LB) intent(inout) :: En !< The internal gravity wave energy density as a !! function of space and angular resolution !! [R Z3 T-2 ~> J m-2]. - type(int_tide_CS), intent(in) :: CS !< Internal tide control struct + type(int_tide_CS), intent(in) :: CS !< Internal tide control structure type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! Local variables real, dimension(G%isd:G%ied,G%jsd:G%jed) :: angle_c @@ -1821,23 +1843,18 @@ subroutine teleport(En, NAngle, CS, G, LB) real :: TwoPi ! 2*pi = 6.2831853... [nondim] real :: Angle_size ! size of beam wedge [rad] real, dimension(1:NAngle) :: angle_i ! angle of incident ray wrt equator [rad] - real, dimension(1:NAngle) :: cos_angle, sin_angle + real, dimension(1:NAngle) :: cos_angle ! Cosine of the beam angle relative to eastward [nondim] + real, dimension(1:NAngle) :: sin_angle ! Sine of the beam angle relative to eastward [nondim] real :: En_tele ! energy to be "teleported" [R Z3 T-2 ~> J m-2] character(len=160) :: mesg ! The text of an error message integer :: i, j, a - !integer :: isd, ied, jsd, jed ! start and end local indices on data domain - ! ! (values include halos) - !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) - integer :: id_g, jd_g ! global (decomp-invar) indices + integer :: id_g, jd_g ! global (decomposition-invariant) indices integer :: jos, ios ! offsets - real :: cos_normal, sin_normal, angle_wall - ! cos/sin of cross-ridge normal, ridge angle + real :: cos_normal, sin_normal ! cos/sin of cross-ridge normal direction [nondim] + real :: angle_wall ! The coastline angle or the complementary angle [radians] - !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) @@ -1907,11 +1924,12 @@ subroutine correct_halo_rotation(En, test, G, NAngle) real, dimension(SZI_(G),SZJ_(G),2), & intent(in) :: test !< An x-unit vector that has been passed through !! the halo updates, to enable the rotation of the - !! wave energies in the halo region to be corrected. + !! wave energies in the halo region to be corrected [nondim]. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. ! Local variables - real, dimension(G%isd:G%ied,NAngle) :: En2d + real, dimension(G%isd:G%ied,NAngle) :: En2d ! A zonal row of the internal gravity wave energy density + ! in a frequency band and mode [R Z3 T-2 ~> J m-2]. integer, dimension(G%isd:G%ied) :: a_shift integer :: i_first, i_last, a_new integer :: a, i, j, isd, ied, jsd, jed, m, fr @@ -1958,18 +1976,19 @@ end subroutine correct_halo_rotation !> Calculates left/right edge values for PPM reconstruction in x-direction. subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. - real, parameter :: oneSixth = 1./6. - real :: h_ip1, h_im1 - real :: dMx, dMn + real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slope in energy density times the cell width [R Z3 T-2 ~> J m-2] + real, parameter :: oneSixth = 1./6. ! One sixth [nondim] + real :: h_ip1, h_im1 ! The energy densities at adjacent points [R Z3 T-2 ~> J m-2] + real :: dMx, dMn ! The maximum and minimum of values of energy density at adjacent points + ! relative to the center point [R Z3 T-2 ~> J m-2] character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil @@ -2032,18 +2051,19 @@ end subroutine PPM_reconstruction_x !> Calculates left/right edge valus for PPM reconstruction in y-direction. subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D) [R Z3 T-2 ~> J m-2] type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. logical, intent(in) :: simple_2nd !< If true, use the arithmetic mean !! energy densities as default edge values !! for a simple 2nd order scheme. ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. - real, parameter :: oneSixth = 1./6. - real :: h_jp1, h_jm1 - real :: dMx, dMn + real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slope in energy density times the cell width [R Z3 T-2 ~> J m-2] + real, parameter :: oneSixth = 1./6. ! One sixth [nondim] + real :: h_jp1, h_jm1 ! The energy densities at adjacent points [R Z3 T-2 ~> J m-2] + real :: dMx, dMn ! The maximum and minimum of values of energy density at adjacent points + ! relative to the center point [R Z3 T-2 ~> J m-2] character(len=256) :: mesg ! The text of an error message integer :: i, j, isl, iel, jsl, jel, stencil @@ -2103,22 +2123,24 @@ end subroutine PPM_reconstruction_y !> Limits the left/right edge values of the PPM reconstruction !! to give a reconstruction that is positive-definite. Here this is -!! reinterpreted as giving a constant thickness if the mean thickness is less +!! reinterpreted as giving a constant value if the mean value is less !! than h_min, with a minimum of h_min otherwise. subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Thickness of layer (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value (2D). - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value (2D). - real, intent(in) :: h_min !< The minimum thickness that can be - !! obtained by a concave parabolic fit. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in each sector (2D) [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value of reconstruction [R Z3 T-2 ~> J m-2] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value of reconstruction [R Z3 T-2 ~> J m-2] + real, intent(in) :: h_min !< The minimum value that can be + !! obtained by a concave parabolic fit [R Z3 T-2 ~> J m-2] integer, intent(in) :: iis !< Start i-index for computations integer, intent(in) :: iie !< End i-index for computations integer, intent(in) :: jis !< Start j-index for computations integer, intent(in) :: jie !< End j-index for computations ! Local variables - real :: curv, dh, scale - integer :: i,j + real :: curv ! The cell-area normalized curvature [R Z3 T-2 ~> J m-2] + real :: dh ! The difference between the edge values [R Z3 T-2 ~> J m-2] + real :: scale ! A rescaling factor used to give a minimum cell value of at least h_min [nondim] + integer :: i, j do j=jis,jie ; do i=iis,iie ! This limiter prevents undershooting minima within the domain with @@ -2144,8 +2166,8 @@ end subroutine PPM_limit_pos ! subroutine register_int_tide_restarts(G, param_file, CS, restart_CS) ! type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure ! type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters -! type(int_tide_CS), intent(in) :: CS !< Internal tide control struct -! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct +! type(int_tide_CS), intent(in) :: CS !< Internal tide control structure +! type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! ! This subroutine is not currently in use!! @@ -2189,15 +2211,15 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate !! diagnostic output. - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure ! Local variables - real :: Angle_size ! size of wedges, rad - real, allocatable :: angles(:) ! orientations of wedge centers, rad + real :: Angle_size ! size of wedges [rad] + real, allocatable :: angles(:) ! orientations of wedge centers [rad] 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 + ! of cells with double-reflecting ridges [nondim] 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 @@ -2216,8 +2238,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) character(len=200) :: refl_angle_file character(len=200) :: refl_pref_file, refl_dbl_file, trans_file character(len=200) :: h2_file - !character(len=200) :: land_mask_file - !character(len=200) :: dy_Cu_file, dx_Cv_file + character(len=80) :: rough_var ! Input file variable names isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -2345,10 +2366,15 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, & "If true, apply wave breaking as a sink.", & default=.false.) + call get_param(param_file, mdl, "EN_CHECK_TOLERANCE", CS%En_check_tol, & + "An energy density tolerance for flagging points with an imbalance in the "//& + "internal tide energy budget when INTERNAL_TIDE_FROUDE_DRAG is True.", & + units="J m-2", default=1.0e-10, scale=US%W_m2_to_RZ3_T3*US%s_to_T, & + do_not_log=.not.CS%apply_Froude_drag) call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& - "the velocity field to the bottom stress.", units="nondim", & - default=0.003) + "the velocity field to the bottom stress.", & + units="nondim", default=0.003) call get_param(param_file, mdl, "INTERNAL_TIDE_ENERGIZED_ANGLE", CS%energized_angle, & "If positive, only one angular band of the internal tides "//& "gets all of the energy. (This is for debugging.)", default=-1) @@ -2389,11 +2415,14 @@ 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 get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & + "The name in the input file of the squared sub-grid-scale "//& + "topographic roughness amplitude variable.", default="h2") 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) + call MOM_read_data(filename, rough_var, h2, G%domain, scale=US%m_to_Z**2) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict RMS topographic roughness to a fraction (10 percent by default) of the column depth. if (RMS_roughness_frac >= 0.0) then @@ -2422,7 +2451,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) if (trim(refl_angle_file) /= '' ) call MOM_error(FATAL, & "REFL_ANGLE_FILE: "//trim(filename)//" not found") endif - ! replace NANs with null value + ! replace NaNs with null value do j=G%jsc,G%jec ; do i=G%isc,G%iec if (is_NaN(CS%refl_angle(i,j))) CS%refl_angle(i,j) = CS%nullangle enddo ; enddo @@ -2502,40 +2531,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo call pass_var(CS%residual,G%domain) - ! Read in prescribed land mask from file (if overwriting -BDM). - ! This should be done in MOM_initialize_topography subroutine - ! defined in MOM_fixed_initialization.F90 (BDM) - !call get_param(param_file, mdl, "LAND_MASK_FILE", land_mask_file, & - ! "The path to the file containing the land mask.", & - ! fail_if_missing=.false.) - !filename = trim(CS%inputdir) // trim(land_mask_file) - !call log_param(param_file, mdl, "INPUTDIR/LAND_MASK_FILE", filename) - !G%mask2dCu(:,:) = 1 ; G%mask2dCv(:,:) = 1 ; G%mask2dT(:,:) = 1 - !call MOM_read_data(filename, 'land_mask', G%mask2dCu, G%domain) - !call MOM_read_data(filename, 'land_mask', G%mask2dCv, G%domain) - !call MOM_read_data(filename, 'land_mask', G%mask2dT, G%domain) - !call pass_vector(G%mask2dCu, G%mask2dCv, G%domain, To_All+Scalar_Pair, CGRID_NE) - !call pass_var(G%mask2dT,G%domain) - - ! Read in prescribed partial east face blockages from file (if overwriting -BDM) - !call get_param(param_file, mdl, "dy_Cu_FILE", dy_Cu_file, & - ! "The path to the file containing the east face blockages.", & - ! fail_if_missing=.false.) - !filename = trim(CS%inputdir) // trim(dy_Cu_file) - !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) - !G%dy_Cu(:,:) = 0.0 - !call MOM_read_data(filename, 'dy_Cu', G%dy_Cu, G%domain, scale=US%m_to_L) - - ! Read in prescribed partial north face blockages from file (if overwriting -BDM) - !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & - ! "The path to the file containing the north face blockages.", & - ! fail_if_missing=.false.) - !filename = trim(CS%inputdir) // trim(dx_Cv_file) - !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) - !G%dx_Cv(:,:) = 0.0 - !call MOM_read_data(filename, 'dx_Cv', G%dx_Cv, G%domain, scale=US%m_to_L) - !call pass_vector(G%dy_Cu, G%dx_Cv, G%domain, To_All+Scalar_Pair, CGRID_NE) - ! Register maps of reflection parameters CS%id_refl_ang = register_diag_field('ocean_model', 'refl_angle', diag%axesT1, & Time, 'Local angle of coastline/ridge/shelf with respect to equator', 'rad') @@ -2550,8 +2545,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & Time, 'East face unblocked width', 'm', conversion=US%L_to_m) CS%id_land_mask = register_diag_field('ocean_model', 'land_mask', diag%axesT1, & - Time, 'Land mask', 'logical') ! used if overriding (BDM) - ! Output reflection parameters as diags here (not needed every timestep) + Time, 'Land mask', 'nondim') + ! Output reflection parameters as diagnostics here (not needed every timestep) if (CS%id_refl_ang > 0) call post_data(CS%id_refl_ang, CS%refl_angle, CS%diag) if (CS%id_refl_pref > 0) call post_data(CS%id_refl_pref, CS%refl_pref, CS%diag) if (CS%id_trans > 0) call post_data(CS%id_trans, CS%trans, CS%diag) @@ -2604,26 +2599,26 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) 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") + id_ang = diag_axis_init("angle", angles, "Radians", "N", "Angular Orientation of Fluxes") 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 + ! Register 2-D energy density (summed over angles) for each frequency and mode write(var_name, '("Itide_En_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy density in frequency ",i1," mode ",i1)') fr, m CS%id_En_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'J m-2', conversion=US%RZ3_T3_to_W_m2*US%T_to_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 3-D (i,j,a) energy density for each freq and mode + ! Register 3-D (i,j,a) energy density for each frequency and mode write(var_name, '("Itide_En_ang_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide angular energy density in frequency ",i1," mode ",i1)') fr, m CS%id_En_ang_mode(fr,m) = register_diag_field('ocean_model', var_name, & axes_ang, Time, var_descript, 'J m-2 band-1', conversion=US%RZ3_T3_to_W_m2*US%T_to_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D energy loss (summed over angles) for each freq and mode + ! Register 2-D energy loss (summed over angles) for each frequency and mode ! wave-drag only write(var_name, '("Itide_wavedrag_loss_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to wave-drag from frequency ",i1," mode ",i1)') fr, m @@ -2637,7 +2632,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) diag%axesT1, Time, var_descript, 'W m-2', conversion=US%RZ3_T3_to_W_m2) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 3-D (i,j,a) energy loss for each freq and mode + ! Register 3-D (i,j,a) energy loss for each frequency and mode ! wave-drag only write(var_name, '("Itide_wavedrag_loss_ang_freq",i1,"_mode",i1)') fr, m write(var_descript, '("Internal tide energy loss due to wave-drag from frequency ",i1," mode ",i1)') fr, m @@ -2645,16 +2640,16 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) axes_ang, Time, var_descript, 'W m-2 band-1', conversion=US%RZ3_T3_to_W_m2) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D period-averaged near-bottom horizonal velocity for each freq and mode + ! Register 2-D period-averaged near-bottom horizontal velocity for each frequency and mode write(var_name, '("Itide_Ub_freq",i1,"_mode",i1)') fr, m - write(var_descript, '("Near-bottom horizonal velocity for frequency ",i1," mode ",i1)') fr, m + write(var_descript, '("Near-bottom horizontal velocity for frequency ",i1," mode ",i1)') fr, m CS%id_Ub_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - ! Register 2-D horizonal phase velocity for each freq and mode + ! Register 2-D horizontal phase velocity for each frequency and mode write(var_name, '("Itide_cp_freq",i1,"_mode",i1)') fr, m - write(var_descript, '("Horizonal phase velocity for frequency ",i1," mode ",i1)') fr, m + write(var_descript, '("Horizontal phase velocity for frequency ",i1," mode ",i1)') fr, m CS%id_cp_mode(fr,m) = register_diag_field('ocean_model', var_name, & diag%axesT1, Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) @@ -2668,7 +2663,7 @@ end subroutine internal_tides_init !> This subroutine deallocates the memory associated with the internal tides control structure subroutine internal_tides_end(CS) - type(int_tide_CS), intent(inout) :: CS !< Internal tide control struct + type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure if (allocated(CS%En)) deallocate(CS%En) if (allocated(CS%frequency)) deallocate(CS%frequency) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 87562a9c83..7d71a62e25 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -48,6 +48,8 @@ module MOM_lateral_mixing_coeffs !! of first baroclinic wave for calculating the resolution fn. logical :: khth_use_ebt_struct !< If true, uses the equivalent barotropic structure !! as the vertical structure of thickness diffusivity. + logical :: kdgl90_use_ebt_struct !< If true, uses the equivalent barotropic structure + !! as the vertical structure of diffusivity in the GL90 scheme. logical :: calculate_cg1 !< If true, calls wave_speed() to calculate the first !! baroclinic wave speed and populate CS%cg1. !! This parameter is set depending on other parameters. @@ -65,6 +67,8 @@ module MOM_lateral_mixing_coeffs !! This parameter is set depending on other parameters. real :: cropping_distance !< Distance from surface or bottom to filter out outcropped or !! incropped interfaces for the Eady growth rate calc [Z ~> m] + real :: h_min_N2 !< The minimum vertical distance to use in the denominator of the + !! bouyancy frequency used in the slope calculation [Z ~> m] real, allocatable :: SN_u(:,:) !< S*N at u-points [T-1 ~> s-1] real, allocatable :: SN_v(:,:) !< S*N at v-points [T-1 ~> s-1] @@ -101,8 +105,8 @@ module MOM_lateral_mixing_coeffs !! spacing squared at v [L2 T-2 ~> m2 s-2]. real, allocatable :: Rd_dx_h(:,:) !< Deformation radius over grid spacing [nondim] - real, allocatable :: slope_x(:,:,:) !< Zonal isopycnal slope [nondim] - real, allocatable :: slope_y(:,:,:) !< Meridional isopycnal slope [nondim] + real, allocatable :: slope_x(:,:,:) !< Zonal isopycnal slope [Z L-1 ~> nondim] + real, allocatable :: slope_y(:,:,:) !< Meridional isopycnal slope [Z L-1 ~> nondim] real, allocatable :: ebt_struct(:,:,:) !< Vertical structure function to scale diffusivities with [nondim] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & @@ -120,12 +124,13 @@ module MOM_lateral_mixing_coeffs ! Parameters logical :: use_Visbeck !< Use Visbeck formulation for thickness diffusivity integer :: VarMix_Ktop !< Top layer to start downward integrals - real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula + real :: Visbeck_L_scale !< Fixed length scale in Visbeck formula [L ~> m], or if negative a scaling + !! factor [nondim] relating this length scale squared to the cell area real :: Eady_GR_D_scale !< Depth over which to average SN [Z ~> m] - real :: Res_coef_khth !< A non-dimensional number that determines the function + real :: Res_coef_khth !< A coefficient [nondim] that determines the function !! of resolution, used for thickness and tracer mixing, as: !! F = 1 / (1 + (Res_coef_khth*Ld/dx)^Res_fn_power) - real :: Res_coef_visc !< A non-dimensional number that determines the function + real :: Res_coef_visc !< A coefficient [nondim] that determines the function !! of resolution, used for lateral viscosity, as: !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) real :: depth_scaled_khth_h0 !< The depth above which KHTH is linearly scaled away [Z ~> m] @@ -137,7 +142,7 @@ module MOM_lateral_mixing_coeffs integer :: Res_fn_power_visc !< The power of dx/Ld in the Kh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. - real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate [nondim]. + real :: Visbeck_S_max !< Upper bound on slope used in Eady growth rate [Z L-1 ~> nondim]. ! Leith parameters logical :: use_QG_Leith_GM !< If true, uses the QG Leith viscosity as the GM coefficient @@ -167,13 +172,13 @@ module MOM_lateral_mixing_coeffs !> Calculates the non-dimensional depth functions. subroutine calc_depth_function(G, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: i, j - real :: H0 ! local variable for reference depth - real :: expo ! exponent used in the depth dependent scaling + real :: H0 ! The depth above which KHTH is linearly scaled away [Z ~> m] + real :: expo ! exponent used in the depth dependent scaling [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -186,6 +191,7 @@ subroutine calc_depth_function(G, CS) if (.not. allocated(CS%Depth_fn_v)) call MOM_error(FATAL, & "calc_depth_function: %Depth_fn_v is not associated with Depth_scaled_KhTh.") + ! For efficiency, the reciprocal of H0 should be used instead. H0 = CS%depth_scaled_khth_h0 expo = CS%depth_scaled_khth_exp !$OMP do @@ -206,7 +212,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables ! Depending on the power-function being used, dimensional rescaling may be limited, so some @@ -227,7 +233,7 @@ subroutine calc_resoln_function(h, tv, G, GV, US, CS) if (CS%calculate_cg1) then if (.not. allocated(CS%cg1)) call MOM_error(FATAL, & "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") - if (CS%khth_use_ebt_struct) then + if (CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct) then if (.not. allocated(CS%ebt_struct)) call MOM_error(FATAL, & "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") if (CS%Resoln_use_ebt) then @@ -454,8 +460,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: dt !< Time increment [T ~> s] - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure ! Local variables real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: & e ! The interface heights relative to mean sea level [Z ~> m]. @@ -470,22 +476,19 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) "Module must be initialized before it is used.") if (CS%calculate_Eady_growth_rate) then + call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_simpler_Eady_growth_rate) then - call find_eta(h, tv, G, GV, US, e, halo_size=2) call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, dzu=dzu, dzv=dzv, & dzSxN=dzSxN, dzSyN=dzSyN, halo=1, OBC=OBC) call calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_u, CS%SN_v) + elseif (CS%use_stored_slopes) then + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & + CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) + call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) else - call find_eta(h, tv, G, GV, US, e, halo_size=2) - if (CS%use_stored_slopes) then - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & - CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) - else - !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) - endif + !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) endif endif @@ -511,27 +514,35 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: slope_x !< Zonal isoneutral slope [Z L-1 ~> nondim] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: N2_u !< Buoyancy (Brunt-Vaisala) frequency !! at u-points [L2 Z-2 T-2 ~> s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: slope_y !< Meridional isoneutral slope + !! [Z L-1 ~> nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: N2_v !< Buoyancy (Brunt-Vaisala) frequency !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure ! Local variables - real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Positive buoyancy frequency or zero [T-2 ~> s-2] + real :: S2 ! Interface slope squared [Z2 L-2 ~> nondim] + real :: N2 ! Positive buoyancy frequency or zero [L2 Z-2 T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] - real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - integer :: is, ie, js, je, nz - integer :: i, j, k - integer :: l_seg - real :: S2max, wNE, wSE, wSW, wNW - real :: H_u(SZIB_(G)), H_v(SZI_(G)) - real :: S2_u(SZIB_(G), SZJ_(G)) - real :: S2_v(SZI_(G), SZJB_(G)) + real :: H_geom ! The geometric mean of Hup and Hdn [H ~> m or kg m-2]. + real :: S2max ! An upper bound on the squared slopes [Z2 L-2 ~> nondim] + real :: wNE, wSE, wSW, wNW ! Weights of adjacent points [nondim] + real :: H_u(SZIB_(G)), H_v(SZI_(G)) ! Layer thicknesses at u- and v-points [H ~> m or kg m-2] + + ! Note that at some points in the code S2_u and S2_v hold the running depth + ! integrals of the squared slope [H ~> m or kg m-2] before the average is taken. + real :: S2_u(SZIB_(G),SZJ_(G)) ! At first the thickness-weighted depth integral of the squared + ! slope [H Z2 L-2 ~> m or kg m-2] and then the average of the + ! squared slope [Z2 L-2 ~> nondim] at u points. + real :: S2_v(SZI_(G),SZJB_(G)) ! At first the thickness-weighted depth integral of the squared + ! slope [H Z2 L-2 ~> m or kg m-2] and then the average of the + ! squared slope [Z2 L-2 ~> nondim] at v points. + + integer :: i, j, k, is, ie, js, je, nz, l_seg if (.not. CS%initialized) call MOM_error(FATAL, "calc_Visbeck_coeffs_old: "// & "Module must be initialized before it is used.") @@ -539,7 +550,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C if (.not. CS%calculate_Eady_growth_rate) return if (.not. allocated(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") - if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. allocated(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:R"// & "%SN_v is not associated with use_variable_mixing.") is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -557,7 +568,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C ! and midlatitude deformation radii, using calc_resoln_function as a template. !$OMP parallel do default(shared) private(S2,H_u,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) - do j = js,je + do j=js,je do I=is-1,ie CS%SN_u(I,j) = 0. ; H_u(I) = 0. ; S2_u(I,j) = 0. enddo @@ -593,7 +604,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C enddo !$OMP parallel do default(shared) private(S2,H_v,Hdn,Hup,H_geom,N2,wNE,wSE,wSW,wNW) - do J = js-1,je + do J=js-1,je do i=is,ie CS%SN_v(i,J) = 0. ; H_v(i) = 0. ; S2_v(i,J) = 0. enddo @@ -628,7 +639,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C enddo enddo -! Offer diagnostic fields for averaging. + ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then if (CS%id_S2_u > 0) call post_data(CS%id_S2_u, S2_u, CS%diag) if (CS%id_S2_v > 0) call post_data(CS%id_S2_v, S2_v, CS%diag) @@ -638,7 +649,7 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C call uvchksum("calc_Visbeck_coeffs_old slope_[xy]", slope_x, slope_y, G%HI, & scale=US%Z_to_L, haloshift=1) call uvchksum("calc_Visbeck_coeffs_old N2_u, N2_v", N2_u, N2_v, G%HI, & - scale=US%L_to_Z**2 * US%s_to_T**2, scalar_pair=.true.) + scale=US%L_to_Z**2*US%s_to_T**2, scalar_pair=.true.) call uvchksum("calc_Visbeck_coeffs_old SN_[uv]", CS%SN_u, CS%SN_v, G%HI, & scale=US%s_to_T, scalar_pair=.true.) endif @@ -667,7 +678,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, real :: sum_dz(SZI_(G)) ! Cumulative sum of z-thicknesses [Z ~> m] real :: vint_SN(SZIB_(G)) ! Cumulative integral of SN [Z T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G)) :: SN_cpy !< SN at u-points [T-1 ~> s-1] - real :: dz_neglect ! An incy wincy distance to avoid division by zero [Z ~> m] + real :: dz_neglect ! A negligibly small distance to avoid division by zero [Z ~> m] real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~> m-1] real :: dB, dT ! Elevation variables used when cropping [Z ~> m] integer :: i, j, k, l_seg @@ -692,7 +703,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo ; enddo !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg,vint_SN,sum_dz) - do j = G%jsc-1,G%jec+1 + do j=G%jsc-1,G%jec+1 do I=G%isc-1,G%iec vint_SN(I) = 0. sum_dz(I) = dz_neglect @@ -735,7 +746,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg) - do J = G%jsc-1,G%jec + do J=G%jsc-1,G%jec do i=G%isc-1,G%iec+1 vint_SN(i) = 0. sum_dz(i) = dz_neglect @@ -776,14 +787,14 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, enddo enddo - do j = G%jsc,G%jec + do j=G%jsc,G%jec do I=G%isc-1,G%iec CS%SN_u(I,j) = sqrt( SN_cpy(I,j)**2 & + 0.25*( (CS%SN_v(i,J)**2 + CS%SN_v(i+1,J-1)**2) & + (CS%SN_v(i+1,J)**2 + CS%SN_v(i,J-1)**2) ) ) enddo enddo - do J = G%jsc-1,G%jec + do J=G%jsc-1,G%jec do i=G%isc,G%iec CS%SN_v(i,J) = sqrt( CS%SN_v(i,J)**2 & + 0.25*( (SN_cpy(I,j)**2 + SN_cpy(I-1,j+1)**2) & @@ -805,26 +816,27 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct + type(VarMix_CS), intent(inout) :: CS !< Variable mixing control structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes !! internally otherwise use slopes stored in CS ! Local variables - real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) - real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) + real :: E_x(SZIB_(G),SZJ_(G)) ! X-slope of interface at u points [Z L-1 ~> nondim] (for diagnostics) + real :: E_y(SZI_(G),SZJB_(G)) ! Y-slope of interface at v points [Z L-1 ~> nondim] (for diagnostics) real :: H_cutoff ! Local estimate of a minimum thickness for masking [H ~> m or kg m-2] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: S2 ! Interface slope squared [nondim] - real :: N2 ! Brunt-Vaisala frequency squared [T-2 ~> s-2] + real :: S2 ! Interface slope squared [Z2 L-2 ~> nondim] + real :: N2 ! Brunt-Vaisala frequency squared [L2 Z-2 T-2 ~> s-2] real :: Hup, Hdn ! Thickness from above, below [H ~> m or kg m-2] real :: H_geom ! The geometric mean of Hup*Hdn [H ~> m or kg m-2]. - real :: one_meter ! One meter in thickness units [H ~> m or kg m-2]. + real :: S2N2_u_local(SZIB_(G),SZJ_(G),SZK_(GV)) ! The depth integral of the slope times + ! the buoyancy frequency squared at u-points [Z T-2 ~> m s-2] + real :: S2N2_v_local(SZI_(G),SZJB_(G),SZK_(GV)) ! The depth integral of the slope times + ! the buoyancy frequency squared at v-points [Z T-2 ~> m s-2] integer :: is, ie, js, je, nz integer :: i, j, k integer :: l_seg - real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(GV)) - real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) if (.not. CS%initialized) call MOM_error(FATAL, "calc_slope_functions_using_just_e: "// & "Module must be initialized before it is used.") @@ -837,7 +849,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) @@ -851,16 +862,16 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop if (calculate_slopes) then ! Calculate the interface slopes E_x and E_y and u- and v- points respectively do j=js-1,je+1 ; do I=is-1,ie - E_x(I,j) = US%Z_to_L*(e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) + E_x(I,j) = (e(i+1,j,K)-e(i,j,K))*G%IdxCu(I,j) ! Mask slopes where interface intersects topography if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. enddo ; enddo do J=js-1,je ; do i=is-1,ie+1 - E_y(i,J) = US%Z_to_L*(e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) + E_y(i,J) = (e(i,j+1,K)-e(i,j,K))*G%IdyCv(i,J) ! Mask slopes where interface intersects topography if (min(h(i,J,k),h(i,J+1,k)) < H_cutoff) E_y(I,j) = 0. enddo ; enddo - else + else ! This branch is not used. do j=js-1,je+1 ; do I=is-1,ie E_x(I,j) = CS%slope_x(I,j,k) if (min(h(I,j,k),h(I+1,j,k)) < H_cutoff) E_x(I,j) = 0. @@ -874,22 +885,22 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop ! Calculate N*S*h from this layer and add to the sum do j=js,je ; do I=is-1,ie S2 = ( E_x(I,j)**2 + 0.25*( & - (E_y(I,j)**2+E_y(I+1,j-1)**2)+(E_y(I+1,j)**2+E_y(I,j-1)**2) ) ) + (E_y(I,j)**2+E_y(I+1,j-1)**2) + (E_y(I+1,j)**2+E_y(I,j-1)**2) ) ) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i+1,j,k)*h(i+1,j,k-1) / (h(i+1,j,k) + h(i+1,j,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) if (min(h(i,j,k-1), h(i+1,j,k-1), h(i,j,k), h(i+1,j,k)) < H_cutoff) & S2 = 0.0 S2N2_u_local(I,j,k) = (H_geom * GV%H_to_Z) * S2 * N2 enddo ; enddo do J=js-1,je ; do i=is,ie S2 = ( E_y(i,J)**2 + 0.25*( & - (E_x(i,J)**2+E_x(i-1,J+1)**2)+(E_x(i,J+1)**2+E_x(i-1,J)**2) ) ) + (E_x(i,J)**2+E_x(i-1,J+1)**2) + (E_x(i,J+1)**2+E_x(i-1,J)**2) ) ) Hdn = 2.*h(i,j,k)*h(i,j,k-1) / (h(i,j,k) + h(i,j,k-1) + h_neglect) Hup = 2.*h(i,j+1,k)*h(i,j+1,k-1) / (h(i,j+1,k) + h(i,j+1,k-1) + h_neglect) H_geom = sqrt(Hdn*Hup) - N2 = GV%g_prime(k)*US%L_to_Z**2 / (GV%H_to_Z * max(Hdn,Hup,one_meter)) + N2 = GV%g_prime(k) / (GV%H_to_Z * max(Hdn, Hup, CS%h_min_N2)) if (min(h(i,j,k-1), h(i,j+1,k-1), h(i,j,k), h(i,j+1,k)) < H_cutoff) & S2 = 0.0 S2N2_v_local(i,J,k) = (H_geom * GV%H_to_Z) * S2 * N2 @@ -954,14 +965,14 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo !! (d/dy(dv/dx - du/dy)) [L-1 T-1 ~> m-1 s-1] ! Local variables real, dimension(SZI_(G),SZJB_(G)) :: & - dslopey_dz, & ! z-derivative of y-slope at v-points [Z-1 ~> m-1] + dslopey_dz, & ! z-derivative of y-slope at v-points [L-1 ~> m-1] h_at_v, & ! Thickness at v-points [H ~> m or kg m-2] beta_v, & ! Beta at v-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_v, & ! Magnitude of vorticity gradient at v-points [T-1 L-1 ~> s-1 m-1] grad_div_mag_v ! Magnitude of divergence gradient at v-points [T-1 L-1 ~> s-1 m-1] real, dimension(SZIB_(G),SZJ_(G)) :: & - dslopex_dz, & ! z-derivative of x-slope at u-points [Z-1 ~> m-1] + dslopex_dz, & ! z-derivative of x-slope at u-points [L-1 ~> m-1] h_at_u, & ! Thickness at u-points [H ~> m or kg m-2] beta_u, & ! Beta at u-points [T-1 L-1 ~> s-1 m-1] grad_vort_mag_u, & ! Magnitude of vorticity gradient at u-points [T-1 L-1 ~> s-1 m-1] @@ -970,52 +981,61 @@ subroutine calc_QG_Leith_viscosity(CS, G, GV, US, h, k, div_xx_dx, div_xx_dy, vo real :: h_at_slope_below ! The thickness below [H ~> m or kg m-2] real :: Ih ! The inverse of a combination of thicknesses [H-1 ~> m-1 or m2 kg-1] real :: f ! A copy of the Coriolis parameter [T-1 ~> s-1] + real :: inv_PI3 ! The inverse of pi cubed [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq,nz - real :: inv_PI3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nz = GV%ke - inv_PI3 = 1.0/((4.0*atan(1.0))**3) + inv_PI3 = 1.0 / ((4.0*atan(1.0))**3) if ((k > 1) .and. (k < nz)) then + ! With USE_QG_LEITH_VISC=True, this might need to change to + ! do j=js-2,je+2 ; do I=is-2,ie+1 + ! but other arrays used here (e.g., h and CS%slope_x) would also need to have wider valid halos. do j=js-1,je+1 ; do I=is-2,Ieq+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) * h(i+1,j,k) ) / & ( ( h(i,j,k-1) * h(i+1,j,k-1) ) * ( h(i,j,k) + h(i+1,j,k) ) & - + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff ) + + ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k-1) + h(i+1,j,k-1) ) + GV%H_subroundoff**2 ) h_at_slope_below = 2. * ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) * h(i+1,j,k+1) ) / & ( ( h(i,j,k) * h(i+1,j,k) ) * ( h(i,j,k+1) + h(i+1,j,k+1) ) & - + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff ) + + ( h(i,j,k+1) * h(i+1,j,k+1) ) * ( h(i,j,k) + h(i+1,j,k) ) + GV%H_subroundoff**2 ) Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopex_dz(I,j) = 2. * ( CS%slope_x(i,j,k) - CS%slope_x(i,j,k+1) ) * Ih h_at_u(I,j) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + ! With USE_QG_LEITH_VISC=True, this might need to change to + ! do J=js-2,je+1 ; do i=is-2,ie+2 do J=js-2,Jeq+1 ; do i=is-1,ie+1 h_at_slope_above = 2. * ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) * h(i,j+1,k) ) / & ( ( h(i,j,k-1) * h(i,j+1,k-1) ) * ( h(i,j,k) + h(i,j+1,k) ) & - + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff ) + + ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k-1) + h(i,j+1,k-1) ) + GV%H_subroundoff**2 ) h_at_slope_below = 2. * ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) * h(i,j+1,k+1) ) / & ( ( h(i,j,k) * h(i,j+1,k) ) * ( h(i,j,k+1) + h(i,j+1,k+1) ) & - + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff ) + + ( h(i,j,k+1) * h(i,j+1,k+1) ) * ( h(i,j,k) + h(i,j+1,k) ) + GV%H_subroundoff**2 ) Ih = 1./ ( ( h_at_slope_above + h_at_slope_below + GV%H_subroundoff ) * GV%H_to_Z ) dslopey_dz(i,J) = 2. * ( CS%slope_y(i,j,k) - CS%slope_y(i,j,k+1) ) * Ih h_at_v(i,J) = 2. * ( h_at_slope_above * h_at_slope_below ) * Ih enddo ; enddo + ! With USE_QG_LEITH_VISC=True, this might need to be + ! do J=js-2,je+1 ; do i=is-1,ie+1 do J=js-1,je ; do i=is-1,Ieq+1 f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J) ) - vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * US%L_to_Z * & + vort_xy_dx(i,J) = vort_xy_dx(i,J) - f * & ( ( h_at_u(I,j) * dslopex_dz(I,j) + h_at_u(I-1,j+1) * dslopex_dz(I-1,j+1) ) & + ( h_at_u(I-1,j) * dslopex_dz(I-1,j) + h_at_u(I,j+1) * dslopex_dz(I,j+1) ) ) / & ( ( h_at_u(I,j) + h_at_u(I-1,j+1) ) + ( h_at_u(I-1,j) + h_at_u(I,j+1) ) + GV%H_subroundoff) enddo ; enddo + ! With USE_QG_LEITH_VISC=True, this might need to be + ! do j=js-1,je+1 ; do I=is-2,ie+1 do j=js-1,Jeq+1 ; do I=is-1,ie f = 0.5 * ( G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) - vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * US%L_to_Z * & + vort_xy_dy(I,j) = vort_xy_dy(I,j) - f * & ( ( h_at_v(i,J) * dslopey_dz(i,J) + h_at_v(i+1,J-1) * dslopey_dz(i+1,J-1) ) & + ( h_at_v(i,J-1) * dslopey_dz(i,J-1) + h_at_v(i+1,J) * dslopey_dz(i+1,J) ) ) / & ( ( h_at_v(i,J) + h_at_v(i+1,J-1) ) + ( h_at_v(i,J-1) + h_at_v(i+1,J) ) + GV%H_subroundoff) @@ -1076,7 +1096,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients ! Local variables - real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo + real :: KhTr_Slope_Cff ! The nondimensional coefficient in the Visbeck formula + ! for the epipycnal tracer diffusivity [nondim] + real :: KhTh_Slope_Cff ! The nondimensional coefficient in the Visbeck formula + ! for the interface depth diffusivity [nondim] + real :: oneOrTwo ! A variable that may be 1 or 2, depending on which form + ! of the equatorial deformation radius us used [nondim] real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when ! calculating the first-mode wave speed [Z ~> m] real :: KhTr_passivity_coeff ! Coefficient setting the ratio between along-isopycnal tracer @@ -1102,6 +1127,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) ! scaled by the resolution function. logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1163,14 +1190,16 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If true, uses the equivalent barotropic structure "//& "as the vertical structure of thickness diffusivity.",& default=.false.) + call get_param(param_file, mdl, "KD_GL90_USE_EBT_STRUCT", CS%kdgl90_use_ebt_struct, & + "If true, uses the equivalent barotropic structure "//& + "as the vertical structure of diffusivity in the GL90 scheme.",& + default=.false.) call get_param(param_file, mdl, "KHTH_SLOPE_CFF", KhTh_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& - "for the interface depth diffusivity", units="nondim", & - default=0.0) + "for the interface depth diffusivity", units="nondim", default=0.0) call get_param(param_file, mdl, "KHTR_SLOPE_CFF", KhTr_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula "//& - "for the epipycnal tracer diffusivity", units="nondim", & - default=0.0) + "for the epipycnal tracer diffusivity", units="nondim", default=0.0) call get_param(param_file, mdl, "USE_STORED_SLOPES", CS%use_stored_slopes,& "If true, the isopycnal slopes are calculated once and "//& "stored for re-use. This uses more memory but avoids calling "//& @@ -1182,12 +1211,12 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) default=1.0e-17, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & default=.false., do_not_log=.true.) - CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn + CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn .or. CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. use_MEKE ! Indicate whether to calculate the Eady growth rate CS%calculate_Eady_growth_rate = use_MEKE .or. (KhTr_Slope_Cff>0.) .or. (KhTh_Slope_Cff>0.) call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & - default=0., do_not_log=.true.) + units="nondim", default=0., do_not_log=.true.) CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (KhTr_passivity_coeff>0.) call get_param(param_file, mdl, "MLE_FRONT_LENGTH", MLE_front_length, & units="m", default=0.0, scale=US%m_to_L, do_not_log=.true.) @@ -1198,8 +1227,15 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "USE_STANLEY_ISO", CS%use_stanley_iso, & "If true, turn on Stanley SGS T variance parameterization "// & "in isopycnal slope code.", default=.false.) + if (CS%use_stanley_iso) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ISO is true.") + endif - if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then + if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct) then in_use = .true. call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & "The depth below which N2 is monotonized to avoid stratification "//& @@ -1214,7 +1250,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "If non-zero, is an upper bound on slopes used in the "//& "Visbeck formula for diffusivity. This does not affect the "//& "isopycnal slope calculation used within thickness diffusion.", & - units="nondim", default=0.0) + units="nondim", default=0.0, scale=US%L_to_Z) else CS%Visbeck_S_max = 0. endif @@ -1259,26 +1295,32 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "The layer number at which to start vertical integration "//& "of S*N for purposes of finding the Eady growth rate.", & units="nondim", default=2) + call get_param(param_file, mdl, "MIN_DZ_FOR_SLOPE_N2", CS%h_min_N2, & + "The minimum vertical distance to use in the denominator of the "//& + "bouyancy frequency used in the slope calculation.", & + units="m", default=1.0, scale=GV%m_to_H, do_not_log=CS%use_stored_slopes) endif endif if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) then in_use = .true. 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) + "The fixed length scale in the Visbeck formula, or if negative a nondimensional "//& + "scaling factor relating this length scale squared to the cell areas.", & + units="m or nondim", default=0.0, scale=US%m_to_L) 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 + ! Undo the rescaling of CS%Visbeck_L_scale. do j=js,je ; do I=is-1,Ieq - CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) + CS%L2u(I,j) = (US%L_to_m*CS%Visbeck_L_scale)**2 * G%areaCu(I,j) enddo ; enddo do J=js-1,Jeq ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2 * G%areaCv(i,J) + CS%L2v(i,J) = (US%L_to_m*CS%Visbeck_L_scale)**2 * G%areaCv(i,J) enddo ; enddo else - CS%L2u(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 - CS%L2v(:,:) = US%m_to_L**2*CS%Visbeck_L_scale**2 + CS%L2u(:,:) = CS%Visbeck_L_scale**2 + CS%L2v(:,:) = CS%Visbeck_L_scale**2 endif CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & @@ -1350,7 +1392,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "positive integer may be used, although even integers "//& "are more efficient to calculate. Setting this greater "//& "than 100 results in a step-function being used.", & - units="nondim", default=2) + default=2) call get_param(param_file, mdl, "VISC_RES_SCALE_COEF", CS%Res_coef_visc, & "A coefficient that determines how Kh is scaled away if "//& "RESOLN_SCALED_... is true, as "//& @@ -1363,7 +1405,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "are more efficient to calculate. Setting this greater "//& "than 100 results in a step-function being used. "//& "This function affects lateral viscosity, Kh, and not KhTh.", & - units="nondim", default=CS%Res_fn_power_khth) + default=CS%Res_fn_power_khth) call get_param(param_file, mdl, "INTERPOLATE_RES_FN", CS%interpolate_Res_fn, & "If true, interpolate the resolution function to the "//& "velocity points from the thickness points; otherwise "//& @@ -1547,7 +1589,7 @@ end subroutine VarMix_init subroutine VarMix_end(CS) type(VarMix_CS), intent(inout) :: CS - if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) & + if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct .or. CS%kdgl90_use_ebt_struct) & deallocate(CS%ebt_struct) if (CS%use_stored_slopes) then diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 0aef33ddc6..fe31eb0de3 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -48,7 +48,7 @@ module MOM_mixed_layer_restrat logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. - real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [R ~> kg m-3]. @@ -61,6 +61,9 @@ module MOM_mixed_layer_restrat type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1] + real :: Kv_restrat !< A viscosity that sets a floor on the momentum mixing rate + !! during restratification [Z2 T-1 ~> m2 s-1] real, dimension(:,:), allocatable :: & MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] @@ -102,8 +105,8 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the - !! PBL scheme [Z ~> m] - type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct + !! planetary boundary layer scheme [Z ~> m] + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure if (.not. CS%initialized) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & @@ -133,11 +136,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the !! PBL scheme [Z ~> m] (not H) - type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control struct + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! Restratifying zonal thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! Restratifying meridional thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -167,21 +171,22 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! layer [nondim]. The vertical sum of a() through the pieces of ! the mixed layer must be 0. real :: b(SZK_(GV)) ! As for a(k) but for the slow-filtered MLD [nondim] - real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml_slow(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays - ! for diagnostic purposes. + real :: uDml(SZIB_(G)) ! Zonal volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml(SZI_(G)) ! Meridional volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: uDml_slow(SZIB_(G)) ! Zonal volume fluxes in the upper half of the boundary layer to + ! restratify the time-filtered boundary layer depth [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml_slow(SZI_(G)) ! Meridional volume fluxes in the upper half of the boundary layer to + ! restratify the time-filtered boundary layer depth [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! Zonal restratification timescale [T ~> s], stored for diagnostics. + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! Meridional restratification timescale [T ~> s], stored for diagnostics. real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] - real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities [R ~> kg m-3] + real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities and density differences [R ~> kg m-3] real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer ! densities [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G)) :: covTS, & !SGS TS covariance in Stanley param; currently 0 [degC ppt] - varS !SGS S variance in Stanley param; currently 0 [ppt2] + real, dimension(SZI_(G)) :: covTS, & ! SGS TS covariance in Stanley param; currently 0 [C S ~> degC ppt] + varS ! SGS S variance in Stanley param; currently 0 [S2 ~> ppt2] real :: aFac, bFac ! Nondimensional ratios [nondim] real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] @@ -189,7 +194,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: zpb ! Fractional position within the mixed layer of the interface below a layer [nondim] real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] - real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] + real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times ! pi squared [nondim] logical :: line_is_empty, keep_going, res_upscale @@ -200,8 +205,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers. - covTS(:)=0.0 !!Functionality not implemented yet; in future, should be passed in tv - varS(:)=0.0 + covTS(:) = 0.0 !!Functionality not implemented yet; in future, should be passed in tv + varS(:) = 0.0 vonKar_x_pi2 = CS%vonKar * 9.8696 @@ -378,7 +383,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -388,19 +394,30 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef + if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 + if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -453,7 +470,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -463,19 +481,30 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef + if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) + ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef2) + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 + if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) @@ -572,10 +601,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var call diag_update_remap_grids(CS%diag) contains - !> Stream function as a function of non-dimensional position within mixed-layer + !> Stream function [nondim] as a function of non-dimensional position within mixed-layer real function psi(z) real, intent(in) :: z !< Fractional mixed layer depth [nondim] - real :: psi1, bottop, xp, dd + real :: psi1 ! The streamfunction structure without the tail [nondim] + real :: bottop, xp, dd ! Local work variables used to generate the streamfunction tail [nondim] !psi1 = max(0., (1. - (2.*z + 1.)**2)) psi1 = max(0., (1. - (2.*z + 1.)**2) * (1. + (5./21.)*(2.*z + 1.)**2)) @@ -604,9 +634,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + ! Local variables - real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] - real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! Restratifying zonal thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! Restratifying meridional thickness transports [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -634,11 +665,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux magnitudes (uDml & vDml) ! to the realized flux in a layer [nondim]. The vertical sum of a() ! through the pieces of the mixed layer must be 0. - real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper - real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales in the zonal and - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D - ! arrays for diagnostic purposes. + real :: uDml(SZIB_(G)) ! Zonal volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml(SZI_(G)) ! Meridional volume fluxes in the upper half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! Zonal restratification timescale [T ~> s], stored for diagnostics. + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! Meridional restratification timescale [T ~> s], stored for diagnostics. real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. @@ -705,8 +735,13 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je ; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 mom_mixrate = vonKar_x_pi2*u_star**2 / & @@ -751,8 +786,13 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + + ! NOTE: growth_time changes answers on some systems, see below. + ! timescale = growth_time(u_star, h_vel, absf, dz_neglect, CS%vonKar, CS%Kv_restrat, CS%ml_restrat_coef) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 mom_mixrate = vonKar_x_pi2*u_star**2 / & @@ -828,6 +868,46 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) end subroutine mixedlayer_restrat_BML +! NOTE: This function appears to change answers on some platforms, so it is +! currently unused in the model, but we intend to introduce it in the future. + +!> Return the growth timescale for the submesoscale mixed layer eddies in [T ~> s] +real function growth_time(u_star, hBL, absf, h_neg, vonKar, Kv_rest, restrat_coef) + real, intent(in) :: u_star !< Surface friction velocity [Z T-1 ~> m s-1] + real, intent(in) :: hBL !< Boundary layer thickness including at least a neglible + !! value to keep it positive definite [Z ~> m] + real, intent(in) :: absf !< Absolute value of the Coriolis parameter [T-1 ~> s-1] + real, intent(in) :: h_neg !< A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] + real, intent(in) :: Kv_rest !< The background laminar vertical viscosity used for restratification [Z2 T-1 ~> m2 s-1] + real, intent(in) :: vonKar !< The von Karman constant, used to scale the turbulent limits + !! on the restratification timescales [nondim] + real, intent(in) :: restrat_coef !< An overall scaling factor for the restratification timescale [nondim] + + ! Local variables + real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] + real :: Kv_eff ! An effective overall viscosity [Z2 T-1 ~> m2 s-1] + real :: pi2 ! A scaling constant that is approximately pi^2 [nondim] + + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + Kv_water + ! momentum mixing rate: pi^2*visc/h_ml^2 + pi2 = 9.8696 ! Approximately pi^2. This is more accurate than the overall uncertainty of the + ! scheme, with a value that is chosen to reproduce previous answers. + if (Kv_rest <= 0.0) then + ! This case reproduces the previous answers, but the extra h_neg is otherwise unnecessary. + mom_mixrate = (pi2*vonKar)*u_star**2 / (absf*hBL**2 + 4.0*(hBL + h_neg)*u_star) + growth_time = restrat_coef * (0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2)) + else + ! Set the mixing rate to the sum of a turbulent mixing rate and a laminar viscous rate. + ! mom_mixrate = pi2*vonKar*u_star**2 / (absf*hBL**2 + 4.0*hBL*u_star) + pi2*Kv_rest / hBL**2 + if (absf*hBL <= 4.0e-16*u_star) then + Kv_eff = pi2 * (Kv_rest + 0.25*vonKar*hBL*u_star) + else + Kv_eff = pi2 * (Kv_rest + vonKar*u_star**2*hBL / (absf*hBL + 4.0*u_star)) + endif + growth_time = (restrat_coef*0.0625) * ((hBL**2*(hBL**2*absf + 2.0*Kv_eff)) / ((hBL**2*absf)**2 + Kv_eff**2)) + endif + +end function growth_time !> Initialize the mixed layer restratification module logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, restart_CS) @@ -838,12 +918,16 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(in) :: restart_CS !< MOM restart control structure ! Local variables real :: H_rescale ! A rescaling factor for thicknesses from the representation in - ! a restart file to the internal representation in this run. - real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. + ! a restart file to the internal representation in this run [nondim]? + real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. [kg T s-1 H-1 L-2 ~> kg m-3 or 1] + real :: omega ! The Earth's rotation rate [T-1 ~> s-1]. + real :: ustar_min_dflt ! The default value for RESTRAT_USTAR_MIN [Z T-1 ~> m s-1] + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j @@ -881,6 +965,13 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_stanley_ml, & "If true, turn on Stanley SGS T variance parameterization "// & "in ML restrat code.", default=.false.) + if (CS%use_stanley_ml) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") + endif call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & 'The value the von Karman constant as used for mixed layer viscosity.', & units='nondim', default=0.41) @@ -927,6 +1018,21 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, units="nondim", default=1.0) endif + call get_param(param_file, mdl, "KV_RESTRAT", CS%Kv_restrat, & + "A small viscosity that sets a floor on the momentum mixing rate during "//& + "restratification. If this is positive, it will prevent some possible "//& + "divisions by zero even if ustar, RESTRAT_USTAR_MIN, and f are all 0.", & + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) + call get_param(param_file, mdl, "OMEGA", omega, & + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) + ustar_min_dflt = 2.0e-4 * omega * (GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) + call get_param(param_file, mdl, "RESTRAT_USTAR_MIN", CS%ustar_min, & + "The minimum value of ustar that will be used by the mixed layer "//& + "restratification module. This can be tiny, but if this is greater than 0, "//& + "it will prevent divisions by zero when f and KV_RESTRAT are zero.", & + units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) + CS%diag => diag flux_to_kg_per_s = GV%H_to_kg_m2 * US%L_to_m**2 * US%s_to_T @@ -986,13 +1092,14 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, end function mixedlayer_restrat_init !> Allocate and register fields in the mixed layer restratification structure for restarts -subroutine mixedlayer_restrat_register_restarts(HI, GV, param_file, CS, restart_CS) +subroutine mixedlayer_restrat_register_restarts(HI, GV, US, param_file, CS, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables logical :: mixedlayer_restrat_init @@ -1003,9 +1110,9 @@ subroutine mixedlayer_restrat_register_restarts(HI, GV, param_file, CS, restart_ if (.not. mixedlayer_restrat_init) return call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & - default=0., do_not_log=.true.) + units="s", default=0., scale=US%s_to_T, do_not_log=.true.) call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & - default=0., do_not_log=.true.) + units="s", default=0., scale=US%s_to_T, 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), source=0.) diff --git a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 index 54b441fa8b..95a9df808c 100644 --- a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 +++ b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 @@ -18,9 +18,9 @@ module MOM_spherical_harmonics !> Control structure for spherical harmonic transforms type, public :: sht_CS ; private logical :: initialized = .False. !< True if this control structure has been initialized. - integer :: ndegree !< Maximum degree of the spherical harmonics [nodim]. + integer :: ndegree !< Maximum degree of the spherical harmonics [nondim]. integer :: lmax !< Number of associated Legendre polynomials of nonnegative m - !! [lmax=(ndegree+1)*(ndegree+2)/2] [nodim]. + !! [lmax=(ndegree+1)*(ndegree+2)/2] [nondim]. real, allocatable :: cos_clatT(:,:) !< Precomputed cosine of colatitude at the t-cells [nondim]. real, allocatable :: Pmm(:,:,:) !< Precomputed associated Legendre polynomials (m=n) at the t-cells [nondim]. real, allocatable :: cos_lonT(:,:,:), & !< Precomputed cosine factors at the t-cells [nondim]. @@ -46,18 +46,18 @@ subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(sht_CS), intent(inout) :: CS !< Control structure for SHT real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: var !< Input 2-D variable [] - real, intent(out) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) - real, intent(out) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) + intent(in) :: var !< Input 2-D variable [A] + real, intent(out) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) [A] + real, intent(out) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) [A] integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics !! overriding ndegree in the CS [nondim] ! local variables - integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nodim] - integer :: Ltot ! Local copy of the number of spherical harmonics [nodim] + integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nondim] + integer :: Ltot ! Local copy of the number of spherical harmonics [nondim] real, dimension(SZI_(G),SZJ_(G)) :: & - pmn, & ! Current associated Legendre polynomials of degree n and order m [nodim] - pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nodim] - pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nodim] + pmn, & ! Current associated Legendre polynomials of degree n and order m [nondim] + pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nondim] + pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nondim] integer :: i, j, k integer :: is, ie, js, je, isd, ied, jsd, jed integer :: m, n, l @@ -143,19 +143,19 @@ end subroutine spherical_harmonics_forward subroutine spherical_harmonics_inverse(G, CS, Snm_Re, Snm_Im, var, Nd) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(sht_CS), intent(in) :: CS !< Control structure for SHT - real, intent(in) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) - real, intent(in) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) + real, intent(in) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) [A] + real, intent(in) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) [A] real, dimension(SZI_(G),SZJ_(G)), & - intent(out) :: var !< Output 2-D variable [] + intent(out) :: var !< Output 2-D variable [A] integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics !! overriding ndegree in the CS [nondim] ! local variables - integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nodim] - real :: mFac ! A constant multiplier. mFac = 1 (if m==0) or 2 (if m>0) [nodim] + integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nondim] + real :: mFac ! A constant multiplier. mFac = 1 (if m==0) or 2 (if m>0) [nondim] real, dimension(SZI_(G),SZJ_(G)) :: & - pmn, & ! Current associated Legendre polynomials of degree n and order m [nodim] - pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nodim] - pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nodim] + pmn, & ! Current associated Legendre polynomials of degree n and order m [nondim] + pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nondim] + pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nondim] integer :: i, j, k integer :: is, ie, js, je, isd, ied, jsd, jed integer :: m, n, l @@ -210,7 +210,7 @@ subroutine spherical_harmonics_init(G, param_file, CS) type(sht_CS), intent(inout) :: CS !< Control structure for spherical harmonic transforms ! local variables - real, parameter :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) [nodim] + real, parameter :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) [nondim] real, parameter :: RADIAN = PI / 180.0 ! Degree to Radian constant [rad/degree] real, dimension(SZI_(G),SZJ_(G)) :: sin_clatT ! sine of colatitude at the t-cells [nondim]. real :: Pmm_coef ! = sqrt{ 1.0/(4.0*PI) * prod[(2k+1)/2k)] } [nondim]. @@ -305,8 +305,8 @@ end subroutine spherical_harmonics_end !> Calculates the number of real elements (cosine) of spherical harmonics given maximum degree Nd. function calc_lmax(Nd) result(lmax) - integer :: lmax !< Number of real spherical harmonic modes [nodim] - integer, intent(in) :: Nd !< Maximum degree [nodim] + integer :: lmax !< Number of real spherical harmonic modes [nondim] + integer, intent(in) :: Nd !< Maximum degree [nondim] lmax = (Nd+2) * (Nd+1) / 2 end function calc_lmax @@ -314,9 +314,9 @@ end function calc_lmax !> Calculates the one-dimensional index number at (n=0, m=m), given order m and maximum degree Nd. !! It is sequenced with degree (n) changing first and order (m) changing second. function order2index(m, Nd) result(l) - integer :: l !< One-dimensional index number [nodim] - integer, intent(in) :: m !< Current order number [nodim] - integer, intent(in) :: Nd !< Maximum degree [nodim] + integer :: l !< One-dimensional index number [nondim] + integer, intent(in) :: m !< Current order number [nondim] + integer, intent(in) :: Nd !< Maximum degree [nondim] l = ((Nd+1) + (Nd+1-(m-1)))*m/2 + 1 end function order2index @@ -379,4 +379,4 @@ end function order2index !! Schaeffer, N., 2013. Efficient spherical harmonic transforms aimed at pseudospectral numerical simulations. !! Geochemistry, Geophysics, Geosystems, 14(3), pp.751-758. !! https://doi.org/10.1002/ggge.20071 -end module MOM_spherical_harmonics \ No newline at end of file +end module MOM_spherical_harmonics diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index c7310e1560..a7ff2f1c0a 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -1,4 +1,4 @@ -!> Thickness diffusion (or Gent McWilliams) +!> Isopycnal height diffusion (or Gent McWilliams diffusion) module MOM_thickness_diffuse ! This file is part of MOM6. See LICENSE.md for the license. @@ -13,6 +13,7 @@ module MOM_thickness_diffuse use MOM_EOS, only : calculate_density_second_derivs use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data, slasher use MOM_interface_heights, only : find_eta use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS @@ -32,17 +33,17 @@ module MOM_thickness_diffuse ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Control structure for thickness diffusion +!> Control structure for thickness_diffuse type, public :: thickness_diffuse_CS ; private logical :: initialized = .false. !< True if this control structure has been initialized. real :: Khth !< Background isopycnal depth diffusivity [L2 T-1 ~> m2 s-1] real :: Khth_Slope_Cff !< Slope dependence coefficient of Khth [nondim] - real :: max_Khth_CFL !< Maximum value of the diffusive CFL for thickness diffusion [nondim] + real :: max_Khth_CFL !< Maximum value of the diffusive CFL for isopycnal height diffusion [nondim] real :: Khth_Min !< Minimum value of Khth [L2 T-1 ~> m2 s-1] real :: Khth_Max !< Maximum value of Khth [L2 T-1 ~> m2 s-1], or 0 for no max - real :: Kh_eta_bg !< Background interface height diffusivity [L2 T-1 ~> m2 s-1] + real :: Kh_eta_bg !< Background isopycnal height diffusivity [L2 T-1 ~> m2 s-1] real :: Kh_eta_vel !< Velocity scale that is multiplied by the grid spacing to give - !! the interface height diffusivity [L T-1 ~> m s-1] + !! the isopycnal height diffusivity [L T-1 ~> m s-1] real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim]. real :: kappa_smooth !< Vertical diffusivity used to interpolate more !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. @@ -69,14 +70,17 @@ module MOM_thickness_diffuse logical :: MEKE_GEOMETRIC !< If true, uses the GM coefficient formulation from the GEOMETRIC !! framework (Marshall et al., 2012) real :: MEKE_GEOMETRIC_alpha!< The nondimensional coefficient governing the efficiency of - !! the GEOMETRIC thickness diffusion [nondim] + !! the GEOMETRIC isopycnal height diffusion [nondim] real :: MEKE_GEOMETRIC_epsilon !< Minimum Eady growth rate for the GEOMETRIC thickness !! diffusivity [T-1 ~> s-1]. integer :: MEKE_GEOM_answer_date !< The vintage of the expressions in the MEKE_GEOMETRIC !! calculation. Values below 20190101 recover the answers from the !! original implementation, while higher values use expressions that !! satisfy rotational symmetry. - logical :: Use_KH_in_MEKE !< If true, uses the thickness diffusivity calculated here to diffuse MEKE. + logical :: Use_KH_in_MEKE !< If true, uses the isopycnal height diffusivity calculated here to diffuse MEKE. + real :: MEKE_min_depth_diff !< The minimum total depth over which to average the diffusivity + !! used for MEKE [H ~> m or kg m-2]. When the total depth is less + !! than this, the diffusivity is scaled away. logical :: GM_src_alt !< If true, use the GM energy conversion form S^2*N^2*kappa rather !! than the streamfunction for the GM source term. logical :: use_GM_work_bug !< If true, use the incorrect sign for the @@ -84,18 +88,21 @@ module MOM_thickness_diffuse real :: Stanley_det_coeff !< The coefficient correlating SGS temperature variance with the mean !! temperature gradient in the deterministic part of the Stanley parameterization. !! Negative values disable the scheme. [nondim] + logical :: read_khth !< If true, read a file containing the spatially varying horizontal + !! isopycnal height diffusivity logical :: use_stanley_gm !< If true, also use the Stanley parameterization in MOM_thickness_diffuse type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics - real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2] + real, allocatable :: GMwork(:,:) !< Work by isopycnal height diffusion [R Z L2 T-3 ~> W m-2] real, allocatable :: diagSlopeX(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] real, allocatable :: diagSlopeY(:,:,:) !< Diagnostic: zonal neutral slope [Z L-1 ~> nondim] - real, allocatable :: Kh_eta_u(:,:) !< Interface height diffusivities at u points [L2 T-1 ~> m2 s-1] - real, allocatable :: Kh_eta_v(:,:) !< Interface height diffusivities in v points [L2 T-1 ~> m2 s-1] + real, allocatable :: Kh_eta_u(:,:) !< Isopycnal height diffusivities at u points [L2 T-1 ~> m2 s-1] + real, allocatable :: Kh_eta_v(:,:) !< Isopycnal height diffusivities in v points [L2 T-1 ~> m2 s-1] real, allocatable :: KH_u_GME(:,:,:) !< Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] real, allocatable :: KH_v_GME(:,:,:) !< Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + real, allocatable :: khth2d(:,:) !< 2D isopycnal height diffusivity at h-points [L2 T-1 ~> m2 s-1] !>@{ !! Diagnostic identifier @@ -109,8 +116,8 @@ module MOM_thickness_diffuse contains -!> Calculates thickness diffusion coefficients and applies thickness diffusion to layer -!! thicknesses, h. Diffusivities are limited to ensure stability. +!> Calculates isopycnal height diffusion coefficients and applies isopycnal height diffusion +!! by modifying to the layer thicknesses, h. Diffusivities are limited to ensure stability. !! Also returns along-layer mass fluxes used in the continuity equation. subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -126,7 +133,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(VarMix_CS), target, intent(in) :: VarMix !< Variable mixing coefficients type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse ! Local variables real :: e(SZI_(G),SZJ_(G),SZK_(GV)+1) ! heights of interfaces, relative to mean ! sea level [Z ~> m], positive up. @@ -134,13 +141,13 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp real :: vhD(SZI_(G),SZJB_(G),SZK_(GV)) ! Diffusive v*h fluxes [L2 H T-1 ~> m3 s-1 or kg s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & - KH_u, & ! interface height diffusivities in u-columns [L2 T-1 ~> m2 s-1] + KH_u, & ! Isopycnal height diffusivities in u-columns [L2 T-1 ~> m2 s-1] int_slope_u ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at u points. The physically correct ! slopes occur at 0, while 1 is used for numerical closures [nondim]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & - KH_v, & ! interface height diffusivities in v-columns [L2 T-1 ~> m2 s-1] + KH_v, & ! Isopycnal height diffusivities in v-columns [L2 T-1 ~> m2 s-1] int_slope_v ! A nondimensional ratio from 0 to 1 that gives the relative ! weighting of the interface slopes to that calculated also ! using density gradients at v points. The physically correct @@ -149,29 +156,32 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp KH_t ! diagnosed diffusivity at tracer points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G)) :: & - KH_u_CFL ! The maximum stable interface height diffusivity at u grid points [L2 T-1 ~> m2 s-1] + KH_u_CFL ! The maximum stable isopycnal 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] + KH_v_CFL ! The maximum stable isopycnal 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_u(SZIB_(G),SZJ_(G)) ! The isopycnal height diffusivity at u points [L2 T-1 ~> m2 s-1] + real :: Khth_Loc_v(SZI_(G),SZJB_(G)) ! The isopycnal height diffusivity at v points [L2 T-1 ~> m2 s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real, dimension(:,:), pointer :: cg1 => null() !< Wave speed [L T-1 ~> m s-1] + real :: hu(SZI_(G),SZJ_(G)) ! A thickness-based mask at u points, used for diagnostics [nondim] + real :: hv(SZI_(G),SZJ_(G)) ! A thickness-based mask at v points, used for diagnostics [nondim] + real :: KH_u_lay(SZI_(G),SZJ_(G)) ! Diagnostic of isopycnal height diffusivities at u-points averaged + ! to layer centers [L2 T-1 ~> m2 s-1] + real :: KH_v_lay(SZI_(G),SZJ_(G)) ! Diagnostic of isopycnal height diffusivities at v-points averaged + ! to layer centers [L2 T-1 ~> m2 s-1] logical :: use_VarMix, Resoln_scaled, Depth_scaled, use_stored_slopes, khth_use_ebt_struct, use_Visbeck logical :: use_QG_Leith integer :: i, j, k, is, ie, js, je, nz - real :: hu(SZI_(G),SZJ_(G)) ! u-thickness [H ~> m or kg m-2] - real :: hv(SZI_(G),SZJ_(G)) ! v-thickness [H ~> m or kg m-2] - real :: KH_u_lay(SZI_(G),SZJ_(G)) ! Thickness diffusivities [L2 T-1 ~> m2 s-1] - real :: KH_v_lay(SZI_(G),SZJ_(G)) ! layer ave thickness diffusivities [L2 T-1 ~> m2 s-1] if (.not. CS%initialized) call MOM_error(FATAL, "MOM_thickness_diffuse: "//& "Module must be initialized before it is used.") if ((.not.CS%thickness_diffuse) & - .or. .not. (CS%Khth > 0.0 .or. VarMix%use_variable_mixing)) return + .or. .not. (CS%Khth > 0.0 .or. CS%read_khth & + .or. VarMix%use_variable_mixing)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke h_neglect = GV%H_subroundoff @@ -214,10 +224,17 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp ! Set the diffusivities. !$OMP parallel default(shared) - !$OMP do - do j=js,je ; do I=is-1,ie - Khth_loc_u(I,j) = CS%Khth - enddo ; enddo + if (.not. CS%read_khth) then + !$OMP do + do j=js,je ; do I=is-1,ie + Khth_loc_u(I,j) = CS%Khth + enddo ; enddo + else ! use 2d KHTH that was read in from file + !$OMP do + do j=js,je ; do I=is-1,ie + Khth_loc_u(I,j) = 0.5 * (CS%khth2d(i,j) + CS%khth2d(i+1,j)) + enddo ; enddo + endif if (use_VarMix) then if (use_Visbeck) then @@ -302,10 +319,17 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo ; enddo ; enddo endif - !$OMP do - do J=js-1,je ; do i=is,ie - Khth_loc_v(i,J) = CS%Khth - enddo ; enddo + if (.not. CS%read_khth) then + !$OMP do + do J=js-1,je ; do i=is,ie + Khth_loc_v(i,J) = CS%Khth + enddo ; enddo + else ! read KHTH from file + !$OMP do + do J=js-1,je ; do i=is,ie + Khth_loc_v(i,J) = 0.5 * (CS%khth2d(i,j) + CS%khth2d(i,j+1)) + enddo ; enddo + endif if (use_VarMix) then if (use_Visbeck) then @@ -518,7 +542,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp enddo do j=js,je ; do i=is,ie - MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(1.0*GV%m_to_H, htot(i,j)) + MEKE%Kh_diff(i,j) = MEKE%Kh_diff(i,j) / MAX(CS%MEKE_min_depth_diff, htot(i,j)) enddo ; enddo endif @@ -570,9 +594,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Kh_u !< Thickness diffusivity on interfaces + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: Kh_u !< Isopycnal height diffusivity !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Kh_v !< Thickness diffusivity on interfaces + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(in) :: Kh_v !< Isopycnal height diffusivity !! at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: uhD !< Zonal mass fluxes @@ -582,7 +606,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(:,:), pointer :: cg1 !< Wave speed [L T-1 ~> m s-1] real, intent(in) :: dt !< Time increment [T ~> s] type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration of @@ -618,7 +642,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real, dimension(SZIB_(G)) :: & drho_dT_u, & ! The derivative of density with temperature at u points [R C-1 ~> kg m-3 degC-1] drho_dS_u ! The derivative of density with salinity at u points [R S-1 ~> kg m-3 ppt-1]. - real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ignored. + real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() + ! with various units that will be ignored [various] real, dimension(SZI_(G)) :: & drho_dT_v, & ! The derivative of density with temperature at v points [R C-1 ~> kg m-3 degC-1] drho_dS_v, & ! The derivative of density with salinity at v points [R S-1 ~> kg m-3 ppt-1]. @@ -640,15 +665,18 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV T_hr, & ! Temperature on the interface at the h (+1) point [C ~> degC]. S_hr, & ! Salinity on the interface at the h (+1) point [S ~> ppt]. pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa]. - real :: Work_u(SZIB_(G),SZJ_(G)) ! The work being done by the thickness - real :: Work_v(SZI_(G),SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W ] + real :: Work_u(SZIB_(G),SZJ_(G)) ! The work done by the isopycnal height diffusion + ! integrated over u-point water columns [R Z L4 T-3 ~> W] + real :: Work_v(SZI_(G),SZJB_(G)) ! The work done by the isopycnal height diffusion + ! integrated over v-point water columns [R Z L4 T-3 ~> W] real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2]. real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] ! The calculation is equal to h * S^2 * N^2 * kappa_GM. real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. - real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density - real :: drdjA, drdjB ! gradients in the layers above (A) and below(B) the - ! interface times the grid spacing [R ~> kg m-3]. + real :: drdiA, drdiB ! Along layer zonal potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. + real :: drdjA, drdjB ! Along layer meridional potential density gradients in the layers above (A) + ! and below (B) the interface times the grid spacing [R ~> kg m-3]. real :: drdkL, drdkR ! Vertical density differences across an interface [R ~> kg m-3]. real :: drdi_u(SZIB_(G),SZK_(GV)) ! Copy of drdi at u-points [R ~> kg m-3]. real :: drdj_v(SZI_(G),SZK_(GV)) ! Copy of drdj at v-points [R ~> kg m-3]. @@ -694,7 +722,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2]. real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver - ! times unit conversion factors [T-2 L2 Z-2 ~> s-2] + ! times unit conversion factors [L2 Z-2 T-2 ~> s-2] real :: Tl(5) ! copy of T in local stencil [C ~> degC] real :: mn_T ! mean of T in local stencil [C ~> degC] real :: mn_T2 ! mean of T**2 in local stencil [C2 ~> degC2] @@ -710,10 +738,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: diag_sfn_unlim_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction before ! applying limiters [H L2 T-1 ~> m3 s-1 or kg s-1] logical :: present_slope_x, present_slope_y, calc_derivatives - integer, dimension(2) :: EOSdom_u ! The shifted i-computational domain to use for equation of + integer, dimension(2) :: EOSdom_u ! The shifted I-computational domain to use for equation of ! state calculations at u-points. - integer, dimension(2) :: EOSdom_v ! The shifted I-computational domain to use for equation of + integer, dimension(2) :: EOSdom_v ! The shifted i-computational domain to use for equation of ! state calculations at v-points. + integer, dimension(2) :: EOSdom_h1 ! The shifted i-computational domain to use for equation of + ! state calculations at h points with 1 extra halo point logical :: use_stanley integer :: is, ie, js, je, nz, IsdB, halo integer :: i, j, k @@ -790,12 +820,14 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%id_sfn_unlim_y > 0) then ; diag_sfn_unlim_y(:,:,1) = 0.0 ; diag_sfn_unlim_y(:,:,nz+1) = 0.0 ; endif EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) + EOSdom_v(:) = EOS_domain(G%HI) + EOSdom_h1(:) = EOS_domain(G%HI, halo=1) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & !$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & !$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, & - !$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,use_stanley, Tsgs2, & + !$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1,use_stanley,Tsgs2, & !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & @@ -836,7 +868,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is-1,ie-is+3]) + tv%eqn_of_state, EOSdom_h1) endif do I=is-1,ie @@ -1066,7 +1098,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ! end of j-loop ! Calculate the meridional fluxes and gradients. - EOSdom_v(:) = EOS_domain(G%HI) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & @@ -1115,10 +1146,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & call calculate_density_second_derivs(T_h, S_h, pres_h, & scrap, scrap, drho_dT_dT_h, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, EOSdom_v) call calculate_density_second_derivs(T_hr, S_hr, pres_hr, & scrap, scrap, drho_dT_dT_hr, scrap, scrap, & - tv%eqn_of_state, dom=[is,ie-is+1]) + tv%eqn_of_state, EOSdom_v) endif do i=is,ie if (calc_derivatives) then @@ -1409,7 +1440,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (find_work) then ; do j=js,je ; do i=is,ie - ! Note that the units of Work_v and Work_u are W, while Work_h is W m-2. + ! Note that the units of Work_v and Work_u are [R Z L4 T-3 ~> W], while Work_h is in [R Z L2 T-3 ~> W m-2]. Work_h = 0.5 * G%IareaT(i,j) * & ((Work_u(I-1,j) + Work_u(I,j)) + (Work_v(i,J-1) + Work_v(i,J))) if (allocated(CS%GMwork)) CS%GMwork(i,j) = Work_h @@ -1472,28 +1503,28 @@ subroutine streamfn_solver(nk, c2_h, hN2, sfn) end subroutine streamfn_solver -!> Add a diffusivity that acts on the interface heights, regardless of the densities +!> Add a diffusivity that acts on the isopycnal heights, regardless of the densities subroutine add_interface_Kh(G, GV, US, CS, Kh_u, Kh_v, Kh_u_CFL, Kh_v_CFL, int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness_diffuse + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Isopycnal height diffusivity !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [L2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Isopycnal height diffusivity !! at v points [L2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable isopycnal height + !! diffusivity at u points [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable isopycnal height + !! diffusivity at v points [L2 T-1 ~> m2 s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration - !! of density gradients. + !! of density gradients [nondim]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: int_slope_v !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration - !! of density gradients. + !! of density gradients [nondim]. ! Local variables integer :: i, j, k, is, ie, js, je, nz @@ -1514,7 +1545,7 @@ subroutine add_interface_Kh(G, GV, US, CS, Kh_u, Kh_v, Kh_u_CFL, Kh_v_CFL, int_s end subroutine add_interface_Kh -!> Modifies thickness diffusivities to untangle layer structures +!> Modifies isopycnal height diffusivities to untangle layer structures subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV, US, CS, & int_slope_u, int_slope_v) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -1522,17 +1553,17 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Thickness diffusivity on interfaces + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kh_u !< Isopycnal height diffusivity !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Thickness diffusivity on interfaces - !! at v points [L2 T-1 ~> m2 s-1] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable thickness diffusivity - !! at u points [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable thickness diffusivity + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: Kh_v !< Isopycnal height diffusivity !! at v points [L2 T-1 ~> m2 s-1] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Kh_u_CFL !< Maximum stable isopycnal height + !! diffusivity at u points [L2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Kh_v_CFL !< Maximum stable isopycnal height + !! diffusivity at v points [L2 T-1 ~> m2 s-1] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure real, intent(in) :: dt !< Time increment [T ~> s] - type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for thickness_diffuse real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: int_slope_u !< Ratio that determine how much of !! the isopycnal slopes are taken directly from !! the interface slopes without consideration @@ -1546,10 +1577,10 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV de_top ! The distances between the top of a layer and the top of the ! region where the detangling is applied [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & - Kh_lay_u ! The tentative interface height diffusivity for each layer at + Kh_lay_u ! The tentative isopycnal height diffusivity for each layer at ! u points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & - Kh_lay_v ! The tentative interface height diffusivity for each layer at + Kh_lay_v ! The tentative isopycnal height diffusivity for each layer at ! v points [L2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & de_bot ! The distances from the bottom of the region where the @@ -1931,7 +1962,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV end subroutine add_detangling_Kh -!> Initialize the thickness diffusion module/structure +!> Initialize the isopycnal height diffusion module and its control structure subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(time_type), intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -1940,10 +1971,11 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) type(param_file_type), intent(in) :: param_file !< Parameter file handles type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation diagnostics - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse ! Local variables character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. + character(len=200) :: khth_file, inputdir, khth_varname ! This include declares and sets the variable "version". # include "version_variable.h" real :: grid_sp ! The local grid spacing [L ~> m] @@ -1951,6 +1983,8 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) real :: strat_floor ! A floor for buoyancy frequency in the Ferrari et al. 2010, ! streamfunction formulation, expressed as a fraction of planetary ! rotation [nondim]. + real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale + ! temperature variance [nondim] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: MEKE_GEOM_answers_2018 ! If true, use expressions in the MEKE_GEOMETRIC calculation @@ -1969,10 +2003,35 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) + call get_param(param_file, mdl, "READ_KHTH", CS%read_khth, & + "If true, read a file (given by KHTH_FILE) containing the "//& + "spatially varying horizontal isopycnal height diffusivity.", & + default=.false.) + if (CS%read_khth) then + if (CS%Khth > 0) then + call MOM_error(FATAL, "thickness_diffuse_init: KHTH > 0 is not "// & + "compatible with READ_KHTH = TRUE. ") + endif + call get_param(param_file, mdl, "INPUTDIR", inputdir, & + "The directory in which all input files are found.", & + default=".", do_not_log=.true.) + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "KHTH_FILE", khth_file, & + "The file containing the spatially varying horizontal "//& + "isopycnal height diffusivity.", default="khth.nc") + call get_param(param_file, mdl, "KHTH_VARIABLE", khth_varname, & + "The name of the isopycnal height diffusivity variable to read "//& + "from KHTH_FILE.", & + default="khth") + khth_file = trim(inputdir) // trim(khth_file) + + allocate(CS%khth2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + call MOM_read_data(khth_file, khth_varname, CS%khth2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call pass_var(CS%khth2d, G%domain) + endif call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & - "The nondimensional coefficient in the Visbeck formula "//& - "for the interface depth diffusivity", units="nondim", & - default=0.0) + "The nondimensional coefficient in the Visbeck formula for "//& + "the interface depth diffusivity", units="nondim", default=0.0) call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & default=0.0, units="m2 s-1", scale=US%m_to_L**2*US%T_to_s) @@ -1984,7 +2043,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "is permitted for the thickness diffusivity. 1.0 is the "//& "marginally unstable value in a pure layered model, but "//& "much smaller numbers (e.g. 0.1) seem to work better for "//& - "ALE-based models.", units = "nondimensional", default=0.8) + "ALE-based models.", units="nondimensional", default=0.8) call get_param(param_file, mdl, "KH_ETA_CONST", CS%Kh_eta_bg, & "The background horizontal diffusivity of the interface heights (without "//& @@ -2050,6 +2109,13 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "USE_STANLEY_GM", CS%use_stanley_gm, & "If true, turn on Stanley SGS T variance parameterization "// & "in GM code.", default=.false.) + if (CS%use_stanley_gm) then + call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & + "Coefficient correlating the temperature gradient and SGS T variance.", & + units="nondim", default=-1.0, do_not_log=.true.) + if (Stanley_coeff < 0.0) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if USE_STANLEY_GM is true.") + endif 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) @@ -2097,6 +2163,10 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, & "If true, uses the thickness diffusivity calculated here to diffuse MEKE.", & default=.false.) + call get_param(param_file, mdl, "MEKE_MIN_DEPTH_DIFF", CS%MEKE_min_depth_diff, & + "The minimum total depth over which to average the diffusivity used for MEKE. "//& + "When the total depth is less than this, the diffusivity is scaled away.", & + units="m", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%Use_KH_in_MEKE) call get_param(param_file, mdl, "USE_GME", CS%use_GME_thickness_diffuse, & "If true, use the GM+E backscatter scheme in association "//& @@ -2179,14 +2249,14 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) end subroutine thickness_diffuse_init -!> Copies ubtav and vbtav from private type into arrays +!> Copies KH_u_GME and KH_v_GME from private type into arrays provided as arguments subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) type(thickness_diffuse_CS), intent(in) :: CS !< Control structure for this module type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< interface height + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: KH_u_GME !< Isopycnal height !! diffusivities at u-faces [L2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: KH_v_GME !< interface height + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: KH_v_GME !< Isopycnal height !! diffusivities at v-faces [L2 T-1 ~> m2 s-1] ! Local variables integer :: i,j,k @@ -2201,9 +2271,9 @@ subroutine thickness_diffuse_get_KH(CS, KH_u_GME, KH_v_GME, G, GV) end subroutine thickness_diffuse_get_KH -!> Deallocate the thickness diffusion control structure +!> Deallocate the thickness_diffus3 control structure subroutine thickness_diffuse_end(CS, CDp) - type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness diffusion + type(thickness_diffuse_CS), intent(inout) :: CS !< Control structure for thickness_diffuse type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity diagnostic control structure if (CS%id_slope_x > 0) deallocate(CS%diagSlopeX) @@ -2219,13 +2289,15 @@ subroutine thickness_diffuse_end(CS, CDp) deallocate(CS%KH_u_GME) deallocate(CS%KH_v_GME) endif + + if (allocated(CS%khth2d)) deallocate(CS%khth2d) end subroutine thickness_diffuse_end !> \namespace mom_thickness_diffuse !! -!! \section section_gm Thickness diffusion (aka Gent-McWilliams) +!! \section section_gm Isopycnal height diffusion (aka Gent-McWilliams) !! -!! Thickness diffusion is implemented via along-layer mass fluxes +!! Isopycnal height diffusion is implemented via along-layer mass fluxes !! \f[ !! h^\dagger \leftarrow h^n - \Delta t \nabla \cdot ( \vec{uh}^* ) !! \f] @@ -2235,7 +2307,8 @@ end subroutine thickness_diffuse_end !! \vec{uh}^* = \delta_k \vec{\psi} . !! \f] !! -!! The GM implementation of thickness diffusion made the streamfunction proportional to the potential density slope +!! The GM implementation of isopycnal height diffusion made the streamfunction proportional +!! to the potential density slope !! \f[ !! \vec{\psi} = - \kappa_h \frac{\nabla_z \rho}{\partial_z \rho} !! = \frac{g\kappa_h}{\rho_o} \frac{\nabla \rho}{N^2} = \kappa_h \frac{M^2}{N^2} @@ -2255,12 +2328,12 @@ end subroutine thickness_diffuse_end !! which recovers the previous streamfunction relation in the limit that \f$ c \rightarrow 0 \f$. !! Here, \f$c=\max(c_{min},c_g)\f$ is the maximum of either \f$c_{min}\f$ and either the first baroclinic mode !! wave-speed or the equivalent barotropic mode wave-speed. -!! \f$N_*^2 = \max(N^2,0)\f$ is a non-negative form of the square of the Brunt-Vaisala frequency. +!! \f$N_*^2 = \max(N^2,0)\f$ is a non-negative form of the square of the buoyancy frequency. !! The parameter \f$\gamma_F\f$ is used to reduce the vertical smoothing length scale. !! \f[ !! \kappa_h = \left( \kappa_o + \alpha_{s} L_{s}^2 < S N > + \alpha_{M} \kappa_{M} \right) r(\Delta x,L_d) !! \f] -!! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the Brunt-Vaisala frequency, +!! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the buoyancy frequency, !! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and !! \f$ r(\Delta x,L_d) \f$ is a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, !! to deformation radius, \f$L_d\f$). The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index dcf12f915f..b2fd8f0ea5 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -30,11 +30,10 @@ module MOM_tidal_forcing !! constituents that could be used. !> Simple type to store astronomical longitudes used to calculate tidal phases. type, public :: astro_longitudes - real :: & - s, & !< Mean longitude of moon [rad] - h, & !< Mean longitude of sun [rad] - p, & !< Mean longitude of lunar perigee [rad] - N !< Longitude of ascending node [rad] + real :: s !< Mean longitude of moon [rad] + real :: h !< Mean longitude of sun [rad] + real :: p !< Mean longitude of lunar perigee [rad] + real :: N !< Longitude of ascending node [rad] end type astro_longitudes !> The control structure for the MOM_tidal_forcing module @@ -67,19 +66,21 @@ module MOM_tidal_forcing type(astro_longitudes) :: tidal_longitudes !< Astronomical longitudes used to calculate !! tidal phases at t = 0. real, allocatable :: & - sin_struct(:,:,:), & !< The sine and cosine based structures that can - cos_struct(:,:,:), & !< be associated with the astronomical forcing [nondim]. - cosphasesal(:,:,:), & !< The cosine and sine of the phase of the - sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. + sin_struct(:,:,:), & !< The sine based structures that can be associated with + !! the astronomical forcing [nondim]. + cos_struct(:,:,:), & !< The cosine based structures that can be associated with + !! the astronomical forcing [nondim]. + cosphasesal(:,:,:), & !< The cosine of the phase of the self-attraction and loading amphidromes [nondim]. + sinphasesal(:,:,:), & !< The sine of the phase of the self-attraction and loading amphidromes [nondim]. ampsal(:,:,:), & !< The amplitude of the SAL [Z ~> m]. - cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the - sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. + cosphase_prev(:,:,:), & !< The cosine of the phase of the amphidromes in the previous tidal solutions [nondim]. + sinphase_prev(:,:,:), & !< The sine of the phase of the amphidromes in the previous tidal solutions [nondim]. amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. type(sht_CS) :: sht !< Spherical harmonic transforms (SHT) for SAL - integer :: sal_sht_Nd !< Maximum degree for SHT [nodim] - real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nodim] - real, allocatable :: Snm_Re(:), & !< Real and imaginary SHT coefficient for SHT SAL - Snm_Im(:) !< [Z ~> m] + integer :: sal_sht_Nd !< Maximum degree for SHT [nondim] + real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nondim] + real, allocatable :: Snm_Re(:), & !< Real SHT coefficient for SHT SAL [Z ~> m] + Snm_Im(:) !< Imaginary SHT coefficient for SHT SAL [Z ~> m] end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -95,13 +96,16 @@ module MOM_tidal_forcing !! (their Equation I.71), which are based on Schureman, 1958. !! For simplicity, the time associated with time_ref should !! be at midnight. These formulas also only make sense if -!! the calendar is gregorian. +!! the calendar is Gregorian. subroutine astro_longitudes_init(time_ref, longitudes) type(time_type), intent(in) :: time_ref !> Time to calculate longitudes for. type(astro_longitudes), intent(out) :: longitudes !> Lunar and solar longitudes at time_ref. + + ! Local variables real :: D !> Time since the reference date [days] real :: T !> Time in Julian centuries [centuries] real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] + ! Find date at time_ref in days since 1900-01-01 D = time_type_to_real(time_ref - set_date(1900, 1, 1)) / (24.0 * 3600.0) ! Time since 1900-01-01 in Julian centuries @@ -125,7 +129,7 @@ end subroutine astro_longitudes_init function eq_phase(constit, longitudes) character (len=2), intent(in) :: constit !> Name of constituent (e.g., M2). type(astro_longitudes), intent(in) :: longitudes !> Mean longitudes calculated using astro_longitudes_init - real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... + real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] real :: eq_phase !> The equilibrium phase argument for the constituent [rad]. select case (constit) @@ -245,13 +249,13 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. - type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control structure ! Local variables real, dimension(SZI_(G), SZJ_(G)) :: & - phase, & ! The phase of some tidal constituent. - lat_rad, lon_rad ! Latitudes and longitudes of h-points in radians. - real :: deg_to_rad + phase, & ! The phase of some tidal constituent [radians]. + lat_rad, lon_rad ! Latitudes and longitudes of h-points [radians]. + real :: deg_to_rad ! A conversion factor from degrees to radians [radian degree-1] real, dimension(MAX_CONSTITUENTS) :: freq_def ! Default frequency for each tidal constituent [s-1] real, dimension(MAX_CONSTITUENTS) :: phase0_def ! Default reference phase for each tidal constituent [rad] real, dimension(MAX_CONSTITUENTS) :: amp_def ! Default amplitude for each tidal constituent [m] @@ -390,7 +394,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) if (CS%tidal_sal_from_file .or. CS%use_prev_tides) then call get_param(param_file, mdl, "TIDAL_INPUT_FILE", tidal_input_files, & "A list of input files for tidal information.", & - default = "", fail_if_missing=.true.) + default="", fail_if_missing=.true.) endif call get_param(param_file, mdl, "TIDE_REF_DATE", tide_ref_date, & @@ -542,7 +546,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) call get_param(param_file, mdl, "TIDAL_SAL_SHT_DEGREE", CS%sal_sht_Nd, & "The maximum degree of the spherical harmonics transformation used for "// & "calculating the self-attraction and loading term for tides.", & - default=0, do_not_log=.not. CS%tidal_sal_sht) + default=0, do_not_log=.not.CS%tidal_sal_sht) call get_param(param_file, mdl, "RHO_0", rhoW, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -551,8 +555,9 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.True.) call get_param(param_file, mdl, "RHO_E", rhoE, & "The mean solid earth density. This is used for calculating the "// & - "self-attraction and loading term.", units="kg m-3", & - default=5517.0, scale=US%kg_m3_to_R, do_not_log=.not. CS%tidal_sal_sht) + "self-attraction and loading term.", & + units="kg m-3", default=5517.0, scale=US%kg_m3_to_R, & + do_not_log=.not.CS%tidal_sal_sht) lmax = calc_lmax(CS%sal_sht_Nd) allocate(CS%Snm_Re(lmax)); CS%Snm_Re(:) = 0.0 allocate(CS%Snm_Im(lmax)); CS%Snm_Im(:) = 0.0 @@ -577,8 +582,8 @@ subroutine calc_love_scaling(nlm, rhoW, rhoE, Love_Scaling) real, dimension(:), intent(out) :: Love_Scaling !< Scaling factors for inverse SHT [nondim] ! Local variables - real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames - real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers + real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames [nondim] + real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers [nondim] integer :: n_tot ! Size of the stored Love numbers integer :: n, m, l @@ -611,8 +616,9 @@ subroutine find_in_files(filenames, varname, array, G, scale) character(len=*), dimension(:), intent(in) :: filenames !< The names of the files to search for the named variable character(len=*), intent(in) :: varname !< The name of the variable to read type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data - real, optional, intent(in) :: scale !< A factor by which to rescale the array. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data [arbitrary] + real, optional, intent(in) :: scale !< A factor by which to rescale the array to translate it + !! into its desired units [arbitrary] ! Local variables integer :: nf @@ -663,7 +669,7 @@ end subroutine tidal_forcing_sensitivity !! column mass anomalies. subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(time_type), intent(in) :: Time !< The time for the caluculation. + type(time_type), intent(in) :: Time !< The time for the calculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height @@ -677,7 +683,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) real :: now ! The relative time compared with the tidal reference [T ~> s] real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m] real :: cosomegat, sinomegat ! The components of the phase [nondim] - real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal [nondim] + real :: eta_prop ! The nondimenional constant of proportionality between eta and eta_tidal [nondim] integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -750,7 +756,7 @@ subroutine calc_SAL_sht(eta, eta_sal, G, CS) !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_sal !< The sea surface height anomaly from !! self-attraction and loading [Z ~> m]. - type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control structure ! Local variables integer :: n, m, l diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 9f5241bb9a..584ccccc93 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -69,8 +69,8 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field. integer :: num_tlevs !< The number of time records contained in the file - real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data. - real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid. + real, dimension(:,:,:), pointer :: p => NULL() !< pointer to the data [various] + real, dimension(:,:,:), pointer :: h => NULL() !< pointer to the data grid [H ~> m or kg m-2] end type p3d !> A structure for creating arrays of pointers to 2D arrays with extra gridding information @@ -78,9 +78,9 @@ module MOM_ALE_sponge integer :: id !< id for FMS external time interpolator integer :: nz_data !< The number of vertical levels in the input field integer :: num_tlevs !< The number of time records contained in the file - real :: scale = 1.0 !< A multiplicative factor by which to rescale input data - real, dimension(:,:), pointer :: p => NULL() !< pointer the data. - real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. + real :: scale = 1.0 !< A multiplicative factor by which to rescale input data [various] + real, dimension(:,:), pointer :: p => NULL() !< pointer to the data [various] + real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid [H ~> m or kg m-2] character(len=:), allocatable :: name !< The name of the input field character(len=:), allocatable :: long_name !< The long name of the input field character(len=:), allocatable :: unit !< The unit of the input field @@ -131,10 +131,10 @@ module MOM_ALE_sponge !! been rearranged for rotational invariance. logical :: time_varying_sponges !< True if using newer sponge code - logical :: spongeDataOngrid !< True if the sponge data are on the model horizontal grid - - logical :: reentrant_x !< grid is reentrant in the x direction - logical :: tripolar_N !< grid is folded at its north edge + logical :: spongeDataOngrid !< True if the sponge data are on the model horizontal grid + real :: varying_input_h_mask !< An input file thickness below which the target values with time-varying + !! sponges are replaced by the value above [H ~> m or kg m-2]. + !! It is not clear why this needs to be greater than 0. !>@{ Diagnostic IDs integer, dimension(MAX_FIELDS_) :: id_sp_tendency !< Diagnostic ids for tracers @@ -255,13 +255,9 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) - call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & - "If true, the domain is zonally reentrant.", default=.true.) - call get_param(param_file, mdl, "TRIPOLAR_N", CS%tripolar_N, & - "Use tripolar connectivity at the northern edge of the "//& - "domain. With TRIPOLAR_N, NIGLOBAL must be even.", default=.false.) CS%time_varying_sponges = .false. CS%nz = GV%ke @@ -452,7 +448,7 @@ end subroutine get_ALE_sponge_thicknesses subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Iresttime_u_in, Iresttime_v_in) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: Iresttime !< The inverse of the restoring time [T-1 ~> s-1]. type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse !! for model parameter values. @@ -510,6 +506,11 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "than PCM. E.g., if PPM is used for remapping, a "//& "PPM reconstruction will also be used within boundary cells.", & default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "VARYING_SPONGE_MASK_THICKNESS", CS%varying_input_h_mask, & + "An input file thickness below which the target values with "//& + "time-varying sponges are replaced by the value above.", & + units="m", default=0.001, scale=GV%m_to_H) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & default=99991231) @@ -545,17 +546,13 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& + "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& "latter takes precedence.", default=default_hor_reg_ans_date) call get_param(param_file, mdl, "SPONGE_DATA_ONGRID", CS%spongeDataOngrid, & "When defined, the incoming sponge data are "//& "assumed to be on the model grid " , & default=.false.) - call get_param(param_file, mdl, "REENTRANT_X", CS%reentrant_x, & - "If true, the domain is zonally reentrant.", default=.true.) - call get_param(param_file, mdl, "TRIPOLAR_N", CS%tripolar_N, & - "Use tripolar connectivity at the northern edge of the "//& - "domain. With TRIPOLAR_N, NIGLOBAL must be even.", default=.false.) CS%time_varying_sponges = .true. CS%nz = GV%ke @@ -700,9 +697,9 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, & type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out). real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & intent(in) :: sp_val !< Field to be used in the sponge, it can have an - !! arbitrary number of layers. + !! arbitrary number of layers [various] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: f_ptr !< Pointer to the field to be damped + target, intent(in) :: f_ptr !< Pointer to the field to be damped [various] character(len=*), intent(in) :: sp_name !< The name of the tracer field character(len=*), optional, & intent(in) :: sp_long_name !< The long name of the tracer field @@ -711,9 +708,10 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, & intent(in) :: sp_unit !< The unit of the tracer field !! if not given, use the none real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. The default is 1. + !! contributions due to dimensional rescaling [various ~> 1]. + !! The default is 1. - real :: scale_fac ! A factor by which to scale sp_val before storing it. + real :: scale_fac ! A factor by which to scale sp_val before storing it [various ~> 1] integer :: k, col character(len=256) :: mesg ! String for error messages character(len=256) :: long_name ! The long name of the tracer field @@ -762,7 +760,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in) [various]. type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out). character(len=*), intent(in) :: sp_name !< The name of the tracer field character(len=*), optional, & @@ -772,7 +770,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, intent(in) :: sp_unit !< The unit of the tracer field !! if not given, use 'none' real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. The default is 1. + !! contributions due to dimensional rescaling [various ~> 1]. + !! The default is 1. ! Local variables integer :: isd, ied, jsd, jed @@ -837,9 +836,10 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, 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] real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. The default is 1. + !! contributions due to dimensional rescaling [various ~> 1]. + !! The default is 1. - real :: scale_fac + real :: scale_fac ! A dimensional rescaling factor [various ~> 1] integer :: k, col if (.not.associated(CS)) return @@ -880,8 +880,9 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename 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] real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any - !! contributions due to dimensional rescaling. For varying - !! velocities the default is the same using US%m_s_to_L_T. + !! contributions due to dimensional rescaling, often in + !! [L s T-1 m-1 ~> 1]. For varying velocities the + !! default is the same as using US%m_s_to_L_T. ! Local variables logical :: override @@ -902,7 +903,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename else CS%Ref_val_u%id = init_external_field(filename_u, fieldname_u) endif - fld_sz(1:4)=-1 + fld_sz(1:4) = -1 call get_external_field_info(CS%Ref_val_u%id, size=fld_sz) CS%Ref_val_u%nz_data = fld_sz(3) CS%Ref_val_u%num_tlevs = fld_sz(4) @@ -913,7 +914,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename else CS%Ref_val_v%id = init_external_field(filename_v, fieldname_v) endif - fld_sz(1:4)=-1 + fld_sz(1:4) = -1 call get_external_field_info(CS%Ref_val_v%id, size=fld_sz) CS%Ref_val_v%nz_data = fld_sz(3) CS%Ref_val_v%num_tlevs = fld_sz(4) @@ -944,29 +945,32 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim]. - real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid - real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid + real, allocatable, dimension(:) :: tmp_val2 ! data values on the original grid [various] + real, dimension(SZK_(GV)) :: tmp_val1 ! data values remapped to model grid [various] 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(:,:,:) :: 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 - real, allocatable, dimension(:,:,:) :: tmp !< A temporary array for thermodynamic sponge tendency diagnostics, + real, allocatable, dimension(:,:,:) :: sp_val ! A temporary array for fields [various] + real, allocatable, dimension(:,:,:) :: mask_z ! A temporary array for field mask at h pts [nondim] + real, allocatable, dimension(:,:,:) :: mask_u ! A temporary array for field mask at u pts [nondim] + real, allocatable, dimension(:,:,:) :: mask_v ! A temporary array for field mask at v pts [nondim] + real, allocatable, dimension(:,:,:) :: tmp !< A temporary array for thermodynamic sponge tendency + !! diagnostics [various] then in [various T-1 ~> various s-1] real, allocatable, dimension(:,:,:) :: tmp_u !< A temporary array for u sponge acceleration diagnostics + !! first in [L T-1 ~> m s-1] then in [L T-2 ~> m s-2] real, allocatable, dimension(:,:,:) :: tmp_v !< A temporary array for v sponge acceleration diagnostics + !! first in [L T-1 ~> m s-1] then in [L T-2 ~> m s-2] real, dimension(:), allocatable :: hsrc ! Source thicknesses [Z ~> m]. ! Local variables for ALE remapping - real, dimension(:), allocatable :: tmpT1d + real, dimension(:), allocatable :: tmpT1d ! A temporary variable for ALE remapping [various] integer :: c, m, i, j, k, is, ie, js, je, nz, nz_data 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 :: missing_value ! The missing value in the input data field [various] + 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 + real :: sp_val_u ! Interpolation of sp_val to u-points, often a velocity in [L T-1 ~> m s-1] + real :: sp_val_v ! Interpolation of sp_val to v-points, often a velocity in [L T-1 ~> m s-1] integer :: nPoints is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -985,17 +989,18 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data - call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, CS%Ref_val(m)%scale, 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, & - answer_date=CS%hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%id, Time, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, & + scale=CS%Ref_val(m)%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & + answer_date=CS%hor_regrid_answer_date) allocate( hsrc(nz_data) ) allocate( tmpT1d(nz_data) ) do c=1,CS%num_col + ! Set i and j to the structured indices of column c. i = CS%col_i(c) ; j = CS%col_j(c) CS%Ref_val(m)%p(1:nz_data,c) = sp_val(i,j,1:nz_data) ! 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 ; 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%Z_ref, G%bathyT(CS%col_i(c),CS%col_j(c)) ) @@ -1007,7 +1012,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) tmpT1d(k) = -99.9 endif hsrc(k) = zTopOfCell - zBottomOfCell - if (hsrc(k)>0.) nPoints = nPoints + 1 + if (hsrc(k) > 0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model @@ -1015,7 +1020,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) CS%Ref_val(m)%h(1:nz_data,c) = GV%Z_to_H*hsrc(1:nz_data) CS%Ref_val(m)%p(1:nz_data,c) = tmpT1d(1:nz_data) do k=2,nz_data - if (CS%Ref_val(m)%h(k,c) <= 0.001*GV%m_to_H) & + if (CS%Ref_val(m)%h(k,c) <= CS%varying_input_h_mask) & ! some confusion here about why the masks are not correct returning from horiz_interp ! reverting to using a minimum thickness criteria CS%Ref_val(m)%p(k,c) = CS%Ref_val(m)%p(k-1,c) @@ -1025,7 +1030,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) enddo endif - tmp_val1(:)=0.0;h_col(:)=0.0 + tmp_val1(:) = 0.0 ; h_col(:) = 0.0 do m=1,CS%fldno nz_data = CS%Ref_val(m)%nz_data allocate(tmp_val2(CS%Ref_val(m)%nz_data)) @@ -1033,14 +1038,13 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) 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 - ! Therefore we use c as per C code and increment the index where necessary. + ! Set i and j to the structured indices of column c. i = CS%col_i(c) ; j = CS%col_j(c) damp = dt * CS%Iresttime_col(c) I1pdamp = 1.0 / (1.0 + damp) tmp_val2(1:nz_data) = CS%Ref_val(m)%p(1:nz_data,c) do k=1,nz - h_col(k)=h(i,j,k) + h_col(k) = h(i,j,k) enddo if (CS%time_varying_sponges) then @@ -1069,10 +1073,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) if (CS%time_varying_sponges) then nz_data = CS%Ref_val_u%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, CS%Ref_val_u%scale, 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,& - answer_date=CS%hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(CS%Ref_val_u%id, Time, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, & + scale=CS%Ref_val_u%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & + answer_date=CS%hor_regrid_answer_date) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc-1, G%jsc:G%jec, :) = 0. @@ -1087,8 +1091,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) allocate( hsrc(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. + ! Set i and j to the structured indices of column c. i = CS%col_i_u(c) ; j = CS%col_j_u(c) if (mask_u(i,j,1) == 1.0) then do k=1,nz_data @@ -1099,7 +1102,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) 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 + 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%Z_ref, G%bathyT(i,j) ) @@ -1108,7 +1111,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) else ! This next block should only ever be reached over land endif hsrc(k) = zTopOfCell - zBottomOfCell - if (hsrc(k)>0.) nPoints = nPoints + 1 + if (hsrc(k) > 0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model @@ -1118,10 +1121,10 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) deallocate(sp_val, mask_u, mask_z, hsrc) nz_data = CS%Ref_val_v%nz_data ! Interpolate from the external horizontal grid and in time - call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, CS%Ref_val_v%scale, 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,& - answer_date=CS%hor_regrid_answer_date) + call horiz_interp_and_extrap_tracer(CS%Ref_val_v%id, Time, G, sp_val, & + mask_z, z_in, z_edges_in, missing_value, & + scale=CS%Ref_val_v%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& + answer_date=CS%hor_regrid_answer_date) ! 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. @@ -1135,8 +1138,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) !call pass_var(mask_z,G%Domain) allocate( hsrc(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. + ! Set i and j to the structured indices of column c. i = CS%col_i_v(c) ; j = CS%col_j_v(c) if (mask_v(i,j,1) == 1.0) then do k=1,nz_data @@ -1147,7 +1149,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) 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 + 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%Z_ref, G%bathyT(i,j) ) @@ -1156,7 +1158,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) else ! This next block should only ever be reached over land endif hsrc(k) = zTopOfCell - zBottomOfCell - if (hsrc(k)>0.) nPoints = nPoints + 1 + if (hsrc(k) > 0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo ! In case data is deeper than model @@ -1254,10 +1256,13 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) ! 3. Call initialize_ALE_sponge using new grid and rotated Iresttime(:,:) ! All the index adjustment should follow from the Iresttime rotation - real, dimension(:,:), allocatable :: Iresttime_in, Iresttime - real, dimension(:,:,:), allocatable :: data_h_in, data_h - real, dimension(:,:,:), allocatable :: sp_val_in, sp_val - real, dimension(:,:,:), pointer :: sp_ptr => NULL() + real, dimension(:,:), allocatable :: Iresttime_in ! Restoring rate on the input sponges [T-1 ~> s-1] + real, dimension(:,:), allocatable :: Iresttime ! Restoring rate on the output sponges [T-1 ~> s-1] + real, dimension(:,:,:), allocatable :: data_h_in ! Grid for the input sponges [H ~> m or kg m-2] + real, dimension(:,:,:), allocatable :: data_h ! Grid for the output sponges [H ~> m or kg m-2] + real, dimension(:,:,:), allocatable :: sp_val_in ! Target data for the input sponges [various] + real, dimension(:,:,:), allocatable :: sp_val ! Target data for the output sponges [various] + real, dimension(:,:,:), pointer :: sp_ptr => NULL() ! Target data for the input sponges [various] integer :: c, c_i, c_j integer :: k, nz_data integer :: n @@ -1378,11 +1383,11 @@ end subroutine rotate_ALE_sponge subroutine update_ALE_sponge_field(sponge, p_old, G, GV, p_new) type(ALE_sponge_CS), intent(inout) :: sponge !< ALE sponge control struct real, dimension(:,:,:), & - target, intent(in) :: p_old !< The previous array of target values + target, intent(in) :: p_old !< The previous array of target values [various] type(ocean_grid_type), intent(in) :: G !< The updated ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: p_new !< The new array of target values + target, intent(in) :: p_new !< The new array of target values [various] integer :: n diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index c68da61abf..0127f8c556 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -73,10 +73,10 @@ module MOM_CVMix_KPP type, public :: KPP_CS ; private ! Parameters - real :: Ri_crit !< Critical bulk Richardson number (defines OBL depth) - real :: vonKarman !< von Karman constant (dimensionless) - real :: cs !< Parameter for computing velocity scale function (dimensionless) - real :: cs2 !< Parameter for multiplying by non-local term + real :: Ri_crit !< Critical bulk Richardson number (defines OBL depth) [nondim] + real :: vonKarman !< von Karman constant (dimensionless) [nondim] + real :: cs !< Parameter for computing velocity scale function (dimensionless) [nondim] + real :: cs2 !< Parameter for multiplying by non-local term [nondim] ! This is active for NLT_SHAPE_CUBIC_LMD only logical :: enhance_diffusion !< If True, add enhanced diffusivity at base of boundary layer. character(len=32) :: interpType !< Type of interpolation to compute bulk Richardson number @@ -85,12 +85,13 @@ module MOM_CVMix_KPP logical :: computeMoninObukhov !< If True, compute Monin-Obukhov limit for OBLdepth logical :: passiveMode !< If True, makes KPP passive meaning it does NOT alter the diffusivity real :: deepOBLoffset !< If non-zero, is a distance from the bottom that the OBL can not - !! penetrate through [m] - real :: minOBLdepth !< If non-zero, is a minimum depth for the OBL [m] + !! penetrate through [Z ~> m] + real :: minOBLdepth !< If non-zero, is a minimum depth for the OBL [Z ~> m] real :: surf_layer_ext !< Fraction of OBL depth considered in the surface layer [nondim] - real :: minVtsqr !< Min for the squared unresolved velocity used in Rib CVMix calculation [m2 s-2] + real :: minVtsqr !< Min for the squared unresolved velocity used in Rib CVMix + !! calculation [L2 T-2 ~> m2 s-2] logical :: fixedOBLdepth !< If True, will fix the OBL depth at fixedOBLdepth_value - real :: fixedOBLdepth_value !< value for the fixed OBL depth when fixedOBLdepth==True. + real :: fixedOBLdepth_value !< value for the fixed OBL depth when fixedOBLdepth==True [Z ~> m] logical :: debug !< If True, calculate checksums and write debugging information character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function @@ -103,21 +104,20 @@ module MOM_CVMix_KPP !! If False, will replace initial diffusivity wherever KPP diffusivity !! is non-zero. real :: min_thickness !< A minimum thickness used to avoid division by small numbers - !! in the vicinity of vanished layers. - ! smg: obsolete below - logical :: correctSurfLayerAvg !< If true, applies a correction to the averaging of surface layer properties - real :: surfLayerDepth !< A guess at the depth of the surface layer (which should 0.1 of OBLdepth) [m] - ! smg: obsolete above + !! in the vicinity of vanished layers [Z ~> m] integer :: SW_METHOD !< Sets method for using shortwave radiation in surface buoyancy flux logical :: LT_K_Enhancement !< Flags if enhancing mixing coefficients due to LT integer :: LT_K_Shape !< Integer for constant or shape function enhancement integer :: LT_K_Method !< Integer for mixing coefficients LT method - real :: KPP_K_ENH_FAC !< Factor to multiply by K if Method is CONSTANT + real :: KPP_K_ENH_FAC !< Factor to multiply by K if Method is CONSTANT [nondim] logical :: LT_Vt2_Enhancement !< Flags if enhancing Vt2 due to LT integer :: LT_VT2_METHOD !< Integer for Vt2 LT method - real :: KPP_VT2_ENH_FAC !< Factor to multiply by VT2 if Method is CONSTANT + real :: KPP_VT2_ENH_FAC !< Factor to multiply by VT2 if Method is CONSTANT [nondim] + real :: MLD_guess_min !< The minimum estimate of the mixed layer depth used to + !! calculate the Langmuir number for Langmuir turbulence + !! enhancement with KPP [Z ~> m] logical :: STOKES_MIXING !< Flag if model is mixing down Stokes gradient - !! This is relavent for which current to use in RiB + !! This is relevant for which current to use in RiB !> CVMix parameters type(CVMix_kpp_params_type), pointer :: KPP_params => NULL() @@ -143,28 +143,29 @@ module MOM_CVMix_KPP !>@} ! Diagnostics arrays - real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL [m] - real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [m] without smoothing - real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent - real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [m] - real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP + real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of ocean boundary layer (OBL) [Z ~> m] + real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [Z ~> m] without smoothing + real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent [nondim] + real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [Z ~> m] + real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP [nondim] real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [R ~> kg m-3] - real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [m2 s-2] - real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) - real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) - real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [s-1] - real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] - real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for bulk Ri [m2 s-2] - real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [m2 s-1] - real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [m2 s-1] - real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [m2 s-1] + real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [L2 T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer [nondim] + real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) [nondim] + real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [Z T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [T-1 ~> s-1] + real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] + real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for + !! bulk Ri [Z2 T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [C ~> degC] real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [S ~> ppt] - real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [m s-1] - real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [m s-1] - real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient - real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 + real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [L T-1 ~> m s-1] + real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [L T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient [nondim] + real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 [nondim] end type KPP_CS @@ -194,8 +195,9 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) # include "version_variable.h" character(len=40) :: mdl = 'MOM_CVMix_KPP' !< name of this module character(len=20) :: string !< local temporary string - character(len=20) :: langmuir_mixing_opt = 'NONE' !< langmuir mixing opt to be passed to CVMix, e.g., LWF16 - character(len=20) :: langmuir_entrainment_opt = 'NONE' !< langmuir entrainment opt to be passed to CVMix, e.g., LWF16 + character(len=20) :: langmuir_mixing_opt = 'NONE' !< Langmuir mixing option to be passed to CVMix, e.g., LWF16 + character(len=20) :: langmuir_entrainment_opt = 'NONE' !< Langmuir entrainment option to be + !! passed to CVMix, e.g., LWF16 logical :: CS_IS_ONE=.false. !< Logical for setting Cs based on Non-local logical :: lnoDGat1=.false. !< True => G'(1) = 0 (shape function) !! False => compute G'(1) as in LMD94 @@ -228,8 +230,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) call get_param(paramFile, mdl, 'N_SMOOTH', CS%n_smooth, & - 'The number of times the 1-1-4-1-1 Laplacian filter is applied on '// & - 'OBL depth.', & + 'The number of times the 1-1-4-1-1 Laplacian filter is applied on OBL depth.', & default=0) if (CS%n_smooth > G%domain%nihalo) then call MOM_error(FATAL,'KPP smoothing number (N_SMOOTH) cannot be greater than NIHALO.') @@ -277,7 +278,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) call get_param(paramFile, mdl, 'DEEP_OBL_OFFSET', CS%deepOBLoffset, & 'If non-zero, the distance above the bottom to which the OBL is clipped '// & 'if it would otherwise reach the bottom. The smaller of this and 0.1D is used.', & - units='m',default=0.) + units='m', default=0., scale=US%m_to_Z) call get_param(paramFile, mdl, 'FIXED_OBLDEPTH', CS%fixedOBLdepth, & 'If True, fix the OBL depth to FIXED_OBLDEPTH_VALUE '// & 'rather than using the OBL depth from CVMix. '// & @@ -287,32 +288,18 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Value for the fixed OBL depth when fixedOBLdepth==True. '// & 'This parameter is for just for testing purposes. '// & 'It will over-ride the OBLdepth computed from CVMix.', & - units='m',default=30.0) + units='m', default=30.0, scale=US%m_to_Z) call get_param(paramFile, mdl, 'SURF_LAYER_EXTENT', CS%surf_layer_ext, & 'Fraction of OBL depth considered in the surface layer.', & - units='nondim',default=0.10) + units='nondim', default=0.10) call get_param(paramFile, mdl, 'MINIMUM_OBL_DEPTH', CS%minOBLdepth, & 'If non-zero, a minimum depth to use for KPP OBL depth. Independent of '// & 'this parameter, the OBL depth is always at least as deep as the first layer.', & - units='m',default=0.) + units='m', default=0., scale=US%m_to_Z) call get_param(paramFile, mdl, 'MINIMUM_VT2', CS%minVtsqr, & 'Min of the unresolved velocity Vt2 used in Rib CVMix calculation.\n'// & 'Scaling: MINIMUM_VT2 = const1*d*N*ws, with d=1m, N=1e-5/s, ws=1e-6 m/s.', & - units='m2/s2',default=1e-10) - -! smg: for removal below - call get_param(paramFile, mdl, 'CORRECT_SURFACE_LAYER_AVERAGE', CS%correctSurfLayerAvg, & - 'If true, applies a correction step to the averaging of surface layer '// & - 'properties. This option is obsolete.', default=.False.) - if (CS%correctSurfLayerAvg) & - call MOM_error(FATAL,'Correct surface layer average disabled in code. To recover \n'// & - ' feature will require code intervention.') - call get_param(paramFile, mdl, 'FIRST_GUESS_SURFACE_LAYER_DEPTH', CS%surfLayerDepth, & - 'The first guess at the depth of the surface layer used for averaging '// & - 'the surface layer properties. If =0, the top model level properties '// & - 'will be used for the surface layer. If CORRECT_SURFACE_LAYER_AVERAGE=True, a '// & - 'subsequent correction is applied. This parameter is obsolete', units='m', default=0.) -! smg: for removal above + units='m2/s2', default=1e-10, scale=US%m_s_to_L_T**2) call get_param(paramFile, mdl, 'NLT_SHAPE', string, & 'MOM6 method to set nonlocal transport profile. '// & @@ -382,16 +369,16 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) call get_param(paramFile, mdl, 'CVMix_ZERO_H_WORK_AROUND', CS%min_thickness, & 'A minimum thickness used to avoid division by small numbers in the vicinity '// & 'of vanished layers. This is independent of MIN_THICKNESS used in other parts of MOM.', & - units='m', default=0.) + units='m', default=0., scale=US%m_to_Z) !/BGR: New options for including Langmuir effects !/ 1. Options related to enhancing the mixing coefficient call get_param(paramFile, mdl, "USE_KPP_LT_K", CS%LT_K_Enhancement, & 'Flag for Langmuir turbulence enhancement of turbulent'//& - 'mixing coefficient.', units="", Default=.false.) + 'mixing coefficient.', Default=.false.) call get_param(paramFile, mdl, "STOKES_MIXING", CS%Stokes_Mixing, & 'Flag for Langmuir turbulence enhancement of turbulent'//& - 'mixing coefficient.', units="", Default=.false.) + 'mixing coefficient.', Default=.false.) if (CS%LT_K_Enhancement) then call get_param(paramFile, mdl, 'KPP_LT_K_SHAPE', string, & 'Vertical dependence of LT enhancement of mixing. '// & @@ -430,15 +417,15 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) "Unrecognized KPP_LT_K_METHOD option: "//trim(string)) end select if (CS%LT_K_METHOD==LT_K_MODE_CONSTANT) then - call get_param(paramFile, mdl, "KPP_K_ENH_FAC",CS%KPP_K_ENH_FAC , & - 'Constant value to enhance mixing coefficient in KPP.', & - default=1.0) + call get_param(paramFile, mdl, "KPP_K_ENH_FAC", CS%KPP_K_ENH_FAC, & + 'Constant value to enhance mixing coefficient in KPP.', & + units="nondim", default=1.0) endif endif !/ 2. Options related to enhancing the unresolved Vt2/entrainment in Rib call get_param(paramFile, mdl, "USE_KPP_LT_VT2", CS%LT_Vt2_Enhancement, & 'Flag for Langmuir turbulence enhancement of Vt2'//& - 'in Bulk Richardson Number.', units="", Default=.false.) + 'in Bulk Richardson Number.', Default=.false.) if (CS%LT_Vt2_Enhancement) then call get_param(paramFile, mdl, "KPP_LT_VT2_METHOD",string , & 'Method to enhance Vt2 in KPP. '// & @@ -470,19 +457,26 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) "Unrecognized KPP_LT_VT2_METHOD option: "//trim(string)) end select if (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then - call get_param(paramFile, mdl, "KPP_VT2_ENH_FAC",CS%KPP_VT2_ENH_FAC , & + call get_param(paramFile, mdl, "KPP_VT2_ENH_FAC", CS%KPP_VT2_ENH_FAC, & 'Constant value to enhance VT2 in KPP.', & - default=1.0) + units="nondim", default=1.0) endif endif + if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then + call get_param(paramFile, mdl, "KPP_LT_MLD_GUESS_MIN", CS%MLD_guess_min, & + "The minimum estimate of the mixed layer depth used to calculate "//& + "the Langmuir number for Langmuir turbulence enhancement with KPP.", & + units="m", default=1.0, scale=US%m_to_Z) + endif + call closeParameterBlock(paramFile) call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) call CVMix_init_kpp( Ri_crit=CS%Ri_crit, & - minOBLdepth=CS%minOBLdepth, & - minVtsqr=CS%minVtsqr, & + minOBLdepth=US%Z_to_m*CS%minOBLdepth, & + minVtsqr=US%L_T_to_m_s**2*CS%minVtsqr, & vonKarman=CS%vonKarman, & surf_layer_ext=CS%surf_layer_ext, & interp_type=CS%interpType, & @@ -500,7 +494,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) ! Register diagnostics CS%diag => diag CS%id_OBLdepth = register_diag_field('ocean_model', 'KPP_OBLdepth', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer calculated by [CVMix] KPP', 'meter', & + 'Thickness of the surface Ocean Boundary Layer calculated by [CVMix] KPP', & + 'meter', conversion=US%Z_to_m, & cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') ! CMOR names are placeholders; must be modified by time period @@ -508,7 +503,8 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) ! omldamax. if (CS%n_smooth > 0) then CS%id_OBLdepth_original = register_diag_field('ocean_model', 'KPP_OBLdepth_original', diag%axesT1, Time, & - 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', 'meter', & + 'Thickness of the surface Ocean Boundary Layer without smoothing calculated by [CVMix] KPP', & + 'meter', conversion=US%Z_to_m, & cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') endif @@ -516,44 +512,53 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', & 'kg/m3', conversion=US%R_to_kg_m3) CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & - 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', 'm2/s2') + 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', & + 'm2/s2', conversion=US%L_T_to_m_s**2) CS%id_BulkRi = register_diag_field('ocean_model', 'KPP_BulkRi', diag%axesTL, Time, & 'Bulk Richardson number used to find the OBL depth used by [CVMix] KPP', 'nondim') CS%id_Sigma = register_diag_field('ocean_model', 'KPP_sigma', diag%axesTi, Time, & 'Sigma coordinate used by [CVMix] KPP', 'nondim') CS%id_Ws = register_diag_field('ocean_model', 'KPP_Ws', diag%axesTL, Time, & - 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', 'm/s') + 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', & + 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_N = register_diag_field('ocean_model', 'KPP_N', diag%axesTi, Time, & - '(Adjusted) Brunt-Vaisala frequency used by [CVMix] KPP', '1/s') + '(Adjusted) Brunt-Vaisala frequency used by [CVMix] KPP', '1/s', conversion=US%s_to_T) CS%id_N2 = register_diag_field('ocean_model', 'KPP_N2', diag%axesTi, Time, & - 'Square of Brunt-Vaisala frequency used by [CVMix] KPP', '1/s2') + 'Square of Brunt-Vaisala frequency used by [CVMix] KPP', '1/s2', conversion=US%s_to_T**2) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & - 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') + 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2', conversion=US%Z_to_m**2*US%s_to_T**2) CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', & 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & - 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') + 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & - 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') + 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & - 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', 'm2/s') + 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_NLTt = register_diag_field('ocean_model', 'KPP_NLtransport_heat', diag%axesTi, Time, & 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & - 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C', conversion=US%C_to_degC) + 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'C', conversion=US%C_to_degC) CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & - 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'ppt', conversion=US%S_to_ppt) + 'Salinity of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'ppt', conversion=US%S_to_ppt) CS%id_Usurf = register_diag_field('ocean_model', 'KPP_Usurf', diag%axesCu1, Time, & - 'i-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') + 'i-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'm/s', conversion=US%L_T_to_m_s) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & - 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') + 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & + 'm/s', conversion=US%L_T_to_m_s) CS%id_EnhK = register_diag_field('ocean_model', 'EnhK', diag%axesTI, Time, & 'Langmuir number enhancement to K as used by [CVMix] KPP','nondim') CS%id_EnhVt2 = register_diag_field('ocean_model', 'EnhVt2', diag%axesTL, Time, & @@ -611,27 +616,31 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP !! [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [nondim] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier - -! Local variables - integer :: i, j, k ! Loop indices - real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces [m2 s-1] - real, dimension( GV%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces [m2 s-1] - real, dimension( GV%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] - - real :: surfFricVel, surfBuoyFlux - real :: sigma, sigmaRatio + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement multiplier [nondim] + + ! Local variables + integer :: i, j, k ! Loop indices + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke ) :: z_cell ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: z_inter ! Cell interface heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces in MKS units [m2 s-1] + real, dimension( GV%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces in MKS units [m2 s-1] + real, dimension( GV%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces [nondim] + + real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] + real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] + real :: sigma ! Fractional vertical position within the boundary layer [nondim] + real :: sigmaRatio ! A cubic function of sigma [nondim] real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] - real :: dh ! The local thickness used for calculating interface positions [m] - real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] + real :: dh ! The local thickness used for calculating interface positions [Z ~> m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] ! For Langmuir Calculations - real :: LangEnhK ! Langmuir enhancement for mixing coefficient + real :: LangEnhK ! Langmuir enhancement for mixing coefficient [nondim] if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & "KPP_calculate: The Waves control structure must be associated if STOKES_MIXING is True.") @@ -654,15 +663,12 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & !$OMP parallel do default(none) firstprivate(nonLocalTrans) & !$OMP private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & !$OMP surfBuoyFlux, Kdiffusivity, Kviscosity, LangEnhK, sigma, & - !$OMP sigmaRatio) & + !$OMP sigmaRatio, z_inter, z_cell) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, Kt, & !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! loop over horizontal points on processor do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip calling KPP for land points - if (G%mask2dT(i,j)==0.) cycle + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then ! things independent of position within the column surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) @@ -672,7 +678,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -682,7 +688,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & enddo ! k-loop finishes surfBuoyFlux = buoy_scale*buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! h to Monin-Obukov (default is false, ie. not used) + ! h to Monin-Obukhov (default is false, ie. not used) ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -751,15 +757,23 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & enddo endif + ! Convert columns to MKS units for passing to CVMix + do k = 1, GV%ke + z_cell(k) = US%Z_to_m*cellHeight(k) + enddo + do K = 1, GV%ke+1 + z_inter(K) = US%Z_to_m*iFaceHeight(K) + enddo + call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] Kdiffusivity(:,1), & ! (inout) Total heat diffusivity [m2 s-1] Kdiffusivity(:,2), & ! (inout) Total salt diffusivity [m2 s-1] - iFaceHeight, & ! (in) Height of interfaces [m] - cellHeight, & ! (in) Height of level centers [m] + z_inter(:), & ! (in) Height of interfaces [m] + z_cell(:), & ! (in) Height of level centers [m] Kviscosity(:), & ! (in) Original viscosity [m2 s-1] Kdiffusivity(:,1), & ! (in) Original heat diffusivity [m2 s-1] Kdiffusivity(:,2), & ! (in) Original salt diffusivity [m2 s-1] - CS%OBLdepth(i,j), & ! (in) OBL depth [m] + US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent nonLocalTrans(:,1),& ! (out) Non-local heat transport [nondim] nonLocalTrans(:,2),& ! (out) Non-local salt transport [nondim] @@ -820,8 +834,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! we apply nonLocalTrans in subroutines ! KPP_NonLocalTransport_temp and KPP_NonLocalTransport_saln - nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temp - nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln + nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temperature + nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! salinity ! set the KPP diffusivity and viscosity to zero for testing purposes if (CS%KPPzeroDiffusivity) then @@ -832,14 +846,14 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! Copy 1d data into 3d diagnostic arrays !/ grabbing obldepth_0d for next time step. - CS%OBLdepthprev(i,j)=CS%OBLdepth(i,j) + CS%OBLdepthprev(i,j) = CS%OBLdepth(i,j) if (CS%id_sigma > 0) then CS%sigma(i,j,:) = 0. - if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) + if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight(:)/CS%OBLdepth(i,j) endif - if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = Kdiffusivity(:,1) - if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = Kdiffusivity(:,2) - if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = Kviscosity(:) + if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = US%m2_s_to_Z2_T * Kdiffusivity(:,1) + if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = US%m2_s_to_Z2_T * Kdiffusivity(:,2) + if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = US%m2_s_to_Z2_T * Kviscosity(:) ! Update output of routine if (.not. CS%passiveMode) then @@ -862,7 +876,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, buoyFlux, Kt, Ks, Kv, & ! end of the horizontal do-loops over the vertical columns - enddo ! i + endif ; enddo ! i enddo ! j call cpu_clock_end(id_clock_KPP_calc) @@ -906,48 +920,63 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult!< Langmuir enhancement factor + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor [nondim] ! Local variables - integer :: i, j, k, km1 ! Loop indices - real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] (negative in ocean) - real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [s-2] - real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars [m s-1] - real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] - real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] - real, dimension( GV%ke ) :: surfBuoyFlux2 - real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] - - ! for EOS calculation + ! Variables for passing to CVMix routines, often in MKS units + real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars in MKS units [m s-1] + real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] + real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] + real, dimension( GV%ke ) :: surfBuoyFlux2 ! Surface buoyancy flux in MKS units [m2 s-3] + real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] + real, dimension( GV%ke ) :: Vt2_1d ! Unresolved squared turbulence velocity for bulk Ri [m2 s-2] + real, dimension( GV%ke ) :: z_cell ! Cell center heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke ) :: OBL_depth ! Cell center depths referenced to surface [m] (positive in ocean) + real, dimension( GV%ke+1 ) :: z_inter ! Cell interface heights referenced to surface [m] (negative in ocean) + real, dimension( GV%ke+1 ) :: N_col ! A column of buoyancy frequencies at interfaces in MKS units [s-1] + real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] + real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] + real :: Coriolis ! Coriolis parameter at tracer points in MKS units [s-1] + real :: KPP_OBL_depth ! Boundary layer depth calculated by CVMix_kpp_compute_OBL_depth in MKS units [m] + + + ! Variables for EOS calculations real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] real, dimension( 3*GV%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] real, dimension( 3*GV%ke ) :: Temp_1D ! A column of temperatures [C ~> degC] real, dimension( 3*GV%ke ) :: Salt_1D ! A column of salinities [S ~> ppt] - real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho ! Gravitational acceleration divided by density in MKS units [m R-1 s-2 ~> m4 kg-1 s-2] - real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] - real :: Uk, Vk - - real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] - real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. - real :: hTot ! Running sum of thickness used in the surface layer average [m] - real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] - real :: delH ! Thickness of a layer [m] - real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer [C ~> degC] - real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer [S ~> ppt] - real :: surfHu, surfU ! Integral and average of u over the surface layer - real :: surfHv, surfV ! Integral and average of v over the surface layer - real :: dh ! The local thickness used for calculating interface positions [m] - real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] - integer :: kk, ksfc, ktmp + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] (negative in ocean) + real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [T-2 ~> s-2] + real :: zBottomMinusOffset ! Height of bottom plus a little bit [Z ~> m] + real :: GoRho ! Gravitational acceleration in MKS units divided by density [m s-2 R-1 ~> m4 kg-1 s-2] + real :: GoRho_Z_L2 ! Gravitational acceleration divided by density times aspect ratio + ! rescaling [Z T-2 R-1 ~> m4 kg-1 s-2] + real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] + real :: Uk, Vk ! Layer velocities relative to their averages in the surface layer [L T-1 ~> m s-1] + real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth [Z ~> m] + real :: hTot ! Running sum of thickness used in the surface layer average [Z ~> m] + real :: buoy_scale ! A unit conversion factor for buoyancy fluxes [m2 T3 L-2 s-3 ~> 1] + real :: delH ! Thickness of a layer [Z ~> m] + real :: surfTemp ! Average of temperature over the surface layer [C ~> degC] + real :: surfHtemp ! Integral of temperature over the surface layer [Z C ~> m degC] + real :: surfSalt ! Average of salinity over the surface layer [S ~> ppt] + real :: surfHsalt ! Integral of salinity over the surface layer [Z S ~> m ppt] + real :: surfHu, surfHv ! Integral of u and v over the surface layer [Z L T-1 ~> m2 s-1] + real :: surfU, surfV ! Average of u and v over the surface layer [Z T-1 ~> m s-1] + real :: dh ! The local thickness used for calculating interface positions [Z ~> m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] ! For Langmuir Calculations - real :: LangEnhVt2 ! Langmuir enhancement for unresolved shear - real, dimension(GV%ke) :: U_H, V_H - real :: MLD_GUESS, LA - real :: surfHuS, surfHvS, surfUs, surfVs + real :: LangEnhVt2 ! Langmuir enhancement for unresolved shear [nondim] + real, dimension(GV%ke) :: U_H, V_H ! Velocities at tracer points [L T-1 ~> m s-1] + real :: MLD_guess ! A guess at the mixed layer depth for calculating the Langmuir number [Z ~> m] + real :: LA ! The local Langmuir number [nondim] + real :: surfHuS, surfHvS ! Stokes drift velocities integrated over the boundary layer [Z L T-1 ~> m2 s-1] + real :: surfUs, surfVs ! Stokes drift velocities averaged over the boundary layer [Z T-1 ~> m s-1] + + integer :: i, j, k, km1, kk, ksfc, ktmp ! Loop indices if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & "KPP_compute_BLD: The Waves control structure must be associated if STOKES_MIXING is True.") @@ -962,29 +991,27 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl call cpu_clock_begin(id_clock_KPP_compute_BLD) ! some constants - GoRho = US%L_T_to_m_s**2*US%m_to_Z * GV%g_Earth / GV%Rho0 + GoRho_Z_L2 = US%L_to_Z**2 * GV%g_Earth / GV%Rho0 + GoRho = US%Z_to_m*US%s_to_T**2 * GoRho_Z_L2 buoy_scale = US%L_to_m**2*US%s_to_T**3 ! loop over horizontal points on processor !$OMP parallel do default(none) private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & - !$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, & + !$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, vt2_1d, & !$OMP ksfc, surfHtemp, surfHsalt, surfHu, surfHv, surfHuS, & !$OMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, & - !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, & - !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_GUESS, LA, rho_1D, & - !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2, & - !$OMP BulkRi_1d, zBottomMinusOffset) & + !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, N_col, & + !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_guess, LA, rho_1D, & + !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, & + !$OMP z_inter, OBL_depth, BulkRi_1d, zBottomMinusOffset) & !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & - !$OMP Temp, Salt, waves, tv, GoRho, u, v, lamult) + !$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult) do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip calling KPP for land points - if (G%mask2dT(i,j)==0.) cycle + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then do k=1,GV%ke - U_H(k) = 0.5 * US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - V_H(k) = 0.5 * US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) + U_H(k) = 0.5 * (u(i,j,k)+u(i-1,j,k)) + V_H(k) = 0.5 * (v(i,j,k)+v(i,j-1,k)) enddo ! things independent of position within the column @@ -1004,7 +1031,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -1021,19 +1048,19 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif enddo - ! average temp, saln, u, v over surface layer - ! use C-grid average to get u,v on T-points. - surfHtemp=0.0 - surfHsalt=0.0 - surfHu =0.0 - surfHv =0.0 - surfHuS =0.0 - surfHvS =0.0 - hTot =0.0 + ! average temperature, salinity, u and v over surface layer + ! use C-grid average to get u and v on T-points. + surfHtemp = 0.0 + surfHsalt = 0.0 + surfHu = 0.0 + surfHv = 0.0 + surfHuS = 0.0 + surfHvS = 0.0 + hTot = 0.0 do ktmp = 1,ksfc ! SLdepth_0d can be between cell interfaces - delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_m ) + delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_Z ) ! surface layer thickness hTot = hTot + delH @@ -1041,11 +1068,11 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH - surfHu = surfHu + 0.5*US%L_T_to_m_s*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH - surfHv = surfHv + 0.5*US%L_T_to_m_s*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH if (CS%Stokes_Mixing) then - surfHus = surfHus + 0.5*US%L_T_to_m_s*(Waves%US_x(i,j,ktmp)+Waves%US_x(i-1,j,ktmp)) * delH - surfHvs = surfHvs + 0.5*US%L_T_to_m_s*(Waves%US_y(i,j,ktmp)+Waves%US_y(i,j-1,ktmp)) * delH + surfHus = surfHus + 0.5*(Waves%US_x(i,j,ktmp)+Waves%US_x(i-1,j,ktmp)) * delH + surfHvs = surfHvs + 0.5*(Waves%US_y(i,j,ktmp)+Waves%US_y(i,j-1,ktmp)) * delH endif enddo @@ -1056,23 +1083,22 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfUs = surfHus / hTot surfVs = surfHvs / hTot - ! vertical shear between present layer and - ! surface layer averaged surfU,surfV. + ! vertical shear between present layer and surface layer averaged surfU and surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*US%L_T_to_m_s*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*US%L_T_to_m_s*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then ! the Stokes drift must be included in the bulk Richardson number ! calculation. - Uk = Uk + (0.5*US%L_T_to_m_s*(Waves%Us_x(i,j,k)+Waves%US_x(i-1,j,k)) - surfUs ) - Vk = Vk + (0.5*US%L_T_to_m_s*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) - surfVs ) + Uk = Uk + (0.5*(Waves%Us_x(i,j,k)+Waves%US_x(i-1,j,k)) - surfUs ) + Vk = Vk + (0.5*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) - surfVs ) endif - deltaU2(k) = Uk**2 + Vk**2 + deltaU2(k) = US%L_T_to_m_s**2 * (Uk**2 + Vk**2) - ! pressure, temp, and saln for EOS + ! pressure, temperature, and salinity for calling the equation of state ! kk+1 = surface fields ! kk+2 = k fields ! kk+3 = km1 fields @@ -1098,10 +1124,10 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl enddo ! k-loop finishes if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then - MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) + MLD_guess = max( CS%MLD_guess_min, abs(CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) - CS%La_SL(i,j)=LA + CS%La_SL(i,j) = LA endif @@ -1115,24 +1141,34 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl km1 = max(1, k-1) kk = 3*(k-1) deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1) - N2_1d(k) = (GoRho * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & - ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) + N2_1d(k) = (GoRho_Z_L2 * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & + ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z) CS%N(i,j,k) = sqrt( max( N2_1d(k), 0.) ) enddo N2_1d(GV%ke+1 ) = 0.0 CS%N(i,j,GV%ke+1 ) = 0.0 + ! Convert columns to MKS units for passing to CVMix + do k = 1, GV%ke + OBL_depth(k) = -US%Z_to_m * cellHeight(k) + z_cell(k) = US%Z_to_m*cellHeight(k) + enddo + do K = 1, GV%ke+1 + N_col(K) = US%s_to_T*CS%N(i,j,K) + z_inter(K) = US%Z_to_m*iFaceHeight(K) + enddo + ! turbulent velocity scales w_s and w_m computed at the cell centers. ! Note that if sigma > CS%surf_layer_ext, then CVMix_kpp_compute_turbulent_scales ! computes w_s and w_m velocity scale at sigma=CS%surf_layer_ext. So we only pass ! sigma=CS%surf_layer_ext for this calculation. call CVMix_kpp_compute_turbulent_scales( & - CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext - -cellHeight, & ! (in) Assume here that OBL depth [m] = -cellHeight(k) - surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] - surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] - CVMix_kpp_params_user=CS%KPP_params ) + CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext + OBL_depth, & ! (in) OBL depth [m] + surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] + surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] + CVMix_kpp_params_user=CS%KPP_params ) ! Determine the enhancement factor for unresolved shear IF (CS%LT_VT2_ENHANCEMENT) then @@ -1159,33 +1195,34 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & - zt_cntr = cellHeight(1:GV%ke), & ! Depth of cell center [m] + zt_cntr=z_cell, & ! Depth of cell center [m] delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [m s-2] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] - N_iface=CS%N(i,j,:), & ! Buoyancy frequency [s-1] + N_iface=N_col, & ! Buoyancy frequency [s-1] EFactor=LangEnhVT2, & ! Langmuir enhancement factor [nondim] - LaSL = CS%La_SL(i,j), & ! surface layer averaged Langmuir number [nondim] - bfsfc = surfBuoyFlux, & ! surface buoyancy flux [m2 s-3] - uStar = uStar(i,j), & ! surface friction velocity [m s-1] + LaSL=CS%La_SL(i,j), & ! surface layer averaged Langmuir number [nondim] + bfsfc=surfBuoyFlux, & ! surface buoyancy flux [m2 s-3] + uStar=surfFricVel, & ! surface friction velocity [m s-1] CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces [m] - CS%OBLdepth(i,j), & ! (out) OBL depth [m] - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers [m] - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] - Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + BulkRi_1d, & ! (in) Bulk Richardson number + z_inter, & ! (in) Height of interfaces [m] + KPP_OBL_depth, & ! (out) OBL depth [m] + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=z_cell, & ! (in) Height of cell centers [m] + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] + Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CS%OBLdepth(i,j) = US%m_to_Z * KPP_OBL_depth ! A hack to avoid KPP reaching the bottom. It was needed during development ! because KPP was unable to handle vanishingly small layers near the bottom. if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(GV%ke+1)) + zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset, -0.1*iFaceHeight(GV%ke+1)) CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif @@ -1197,41 +1234,42 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! compute unresolved squared velocity for diagnostics if (CS%id_Vt2 > 0) then - CS%Vt2(i,j,:) = CVmix_kpp_compute_unresolved_shear( & - cellHeight(1:GV%ke), & ! Depth of cell center [m] - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] - N_iface=CS%N(i,j,:), & ! Buoyancy frequency at interface [s-1] + Vt2_1d(:) = CVmix_kpp_compute_unresolved_shear( & + z_cell, & ! Depth of cell center [m] + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] + N_iface=N_col, & ! Buoyancy frequency at interface [s-1] EFactor=LangEnhVT2, & ! Langmuir enhancement factor [nondim] LaSL=CS%La_SL(i,j), & ! surface layer averaged Langmuir number [nondim] bfsfc=surfBuoyFlux, & ! surface buoyancy flux [m2 s-3] - uStar=uStar(i,j), & ! surface friction velocity [m s-1] + uStar=surfFricVel, & ! surface friction velocity [m s-1] CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CS%Vt2(i,j,:) = US%m_to_Z*US%T_to_s * Vt2_1d(:) endif ! recompute wscale for diagnostics, now that we in fact know boundary layer depth !BGR consider if LTEnhancement is wanted for diagnostics if (CS%id_Ws > 0) then - call CVMix_kpp_compute_turbulent_scales( & - -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate - CS%OBLdepth(i,j), & ! (in) OBL depth [m] + call CVMix_kpp_compute_turbulent_scales( & + -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters - CS%Ws(i,j,:) = Ws_1d(:) + CS%Ws(i,j,:) = US%m_to_Z*US%T_to_s*Ws_1d(:) endif ! Diagnostics if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) - if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) + if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = US%m_s_to_L_T**2 * deltaU2(:) if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV - enddo + endif ; enddo enddo call cpu_clock_end(id_clock_KPP_compute_BLD) @@ -1252,28 +1290,29 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) ! BLD smoothing: - if (CS%n_smooth > 0) call KPP_smooth_BLD(CS,G,GV,h) + if (CS%n_smooth > 0) call KPP_smooth_BLD(CS, G, GV, US, h) end subroutine KPP_compute_BLD !> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise -subroutine KPP_smooth_BLD(CS,G,GV,h) +subroutine KPP_smooth_BLD(CS, G, GV, US, h) ! Arguments type(KPP_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] ! local - real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [m] - real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [m] + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [Z ~> m] + real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] ! (negative in the ocean) - real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [m] + real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] ! (negative in the ocean) real :: wc, ww, we, wn, ws ! averaging weights for smoothing [nondim] - real :: dh ! The local thickness used for calculating interface positions [m] - real :: hcorr ! A cumulative correction arising from inflation of vanished layers [m] + real :: dh ! The local thickness used for calculating interface positions [Z ~> m] + real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] integer :: i, j, k, s call cpu_clock_begin(id_clock_KPP_smoothing) @@ -1288,20 +1327,17 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) OBLdepth_prev = CS%OBLdepth ! apply smoothing on OBL depth - !$OMP parallel do default(none) shared(G, GV, CS, h, OBLdepth_prev) & + !$OMP parallel do default(none) shared(G, GV, US, CS, h, OBLdepth_prev) & !$OMP private(wc, ww, we, wn, ws, dh, hcorr, cellHeight, iFaceHeight) do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip land points - if (G%mask2dT(i,j)==0.) cycle + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -1328,7 +1364,7 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) ! prevent OBL depths deeper than the bathymetric depth CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - enddo + endif ; enddo enddo enddo ! s-loop @@ -1347,12 +1383,12 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD !< Boundary layer depth [Z ~> m] or other units real, optional, intent(in) :: m_to_BLD_units !< A conversion factor from meters - !! to the desired units for BLD + !! to the desired units for BLD [various] ! Local variables - real :: scale ! A dimensional rescaling factor + real :: scale ! A dimensional rescaling factor in [nondim] or other units. integer :: i,j - scale = US%m_to_Z ; if (present(m_to_BLD_units)) scale = m_to_BLD_units + scale = 1.0 ; if (present(m_to_BLD_units)) scale = US%Z_to_m*m_to_BLD_units !$OMP parallel do default(none) shared(BLD, CS, G, scale) do j = G%jsc, G%jec ; do i = G%isc, G%iec @@ -1376,11 +1412,12 @@ subroutine KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, & type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) real, optional, intent(in) :: flux_scale !< Scale factor to get surfFlux - !! into proper units + !! into proper units [various] integer :: i, j, k real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dtracer ! Rate of tracer change [conc T-1 ~> conc s-1] - real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc + real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc ! An optionally rescaled surface flux of the scalar + ! in [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] or other units ! term used to scale if (present(flux_scale)) then diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 58d6e3417a..e26c061929 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -27,14 +27,14 @@ module MOM_CVMix_conv type, public :: CVMix_conv_cs ; private ! Parameters - real :: kd_conv_const !< diffusivity constant used in convective regime [m2 s-1] - real :: kv_conv_const !< viscosity constant used in convective regime [m2 s-1] + real :: kd_conv_const !< diffusivity constant used in convective regime [Z2 T-1 ~> m2 s-1] + real :: kv_conv_const !< viscosity constant used in convective regime [Z2 T-1 ~> m2 s-1] real :: bv_sqr_conv !< Threshold for squared buoyancy frequency - !! needed to trigger Brunt-Vaisala parameterization [s-2] - real :: min_thickness !< Minimum thickness allowed [m] + !! needed to trigger Brunt-Vaisala parameterization [T-2 ~> s-2] + real :: min_thickness !< Minimum thickness allowed [Z ~> m] logical :: debug !< If true, turn on debugging - ! Daignostic handles and pointers + ! Diagnostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() !< Pointer to diagnostics control structure !>@{ Diagnostics handles integer :: id_N2 = -1, id_kd_conv = -1, id_kv_conv = -1 @@ -55,13 +55,13 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convetction control struct + type(CVMix_conv_cs), intent(inout) :: CS !< CVMix convection control structure - real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. + real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities [nondim] logical :: useEPBL !< If True, use the ePBL boundary layer scheme. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" ! Read parameters call get_param(param_file, mdl, "USE_CVMix_CONVECTION", CVMix_conv_init, default=.false., do_not_log=.true.) @@ -90,7 +90,8 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & + units="m", scale=US%m_to_Z, default=0.001, do_not_log=.True.) call openParameterBlock(param_file,'CVMix_CONVECTION') @@ -102,12 +103,12 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & "Diffusivity used in convective regime. Corresponding viscosity "//& "(KV_CONV) will be set to KD_CONV * PRANDTL_CONV.", & - units='m2/s', default=1.00) + units='m2/s', default=1.00, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & "Threshold for squared buoyancy frequency needed to trigger "//& "Brunt-Vaisala parameterization.", & - units='1/s^2', default=0.0) + units='1/s^2', default=0.0, scale=US%T_to_s**2) call closeParameterBlock(param_file) @@ -123,10 +124,10 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) - call CVMix_init_conv(convect_diff=CS%kd_conv_const, & - convect_visc=CS%kv_conv_const, & + call CVMix_init_conv(convect_diff=US%Z2_T_to_m2_s*CS%kd_conv_const, & + convect_visc=US%Z2_T_to_m2_s*CS%kv_conv_const, & lBruntVaisala=.true., & - BVsqr_convect=CS%bv_sqr_conv) + BVsqr_convect=US%s_to_T**2*CS%bv_sqr_conv) end function CVMix_conv_init @@ -139,7 +140,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. - type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control struct + type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: Kd !< Diapycnal diffusivity at each interface that @@ -153,10 +154,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) !! here [Z2 T-1 ~> m2 s-1]. ! local variables - real, dimension(SZK_(GV)) :: rho_lwr !< Adiabatic Water Density, this is a dummy + real, dimension(SZK_(GV)) :: rho_lwr !< Adiabatic Water Density [kg m-3], this is a dummy !! variable since here convection is always !! computed based on Brunt Vaisala. - real, dimension(SZK_(GV)) :: rho_1d !< water density in a column, this is also + real, dimension(SZK_(GV)) :: rho_1d !< water density in a column [kg m-3], this is also !! a dummy variable, same reason as above. real, dimension(SZK_(GV)+1) :: N2 !< Squared buoyancy frequency [s-2] real, dimension(SZK_(GV)+1) :: kv_col !< Viscosities at interfaces in the column [m2 s-1] @@ -167,14 +168,14 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) kd_conv, & !< Diffusivity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] kv_conv, & !< Viscosity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] N2_3d !< Squared buoyancy frequency for diagnostics [T-2 ~> s-2] - integer :: kOBL !< level of OBL extent - real :: g_o_rho0 ! Gravitational acceleration divided by density times unit convserion factors + integer :: kOBL !< level of ocean boundary layer extent + real :: g_o_rho0 ! Gravitational acceleration divided by density times unit conversion factors ! [Z s-2 R-1 ~> m4 s-2 kg-1] real :: pref ! Interface pressures [R L2 T-2 ~> Pa] real :: rhok, rhokm1 ! In situ densities of the layers above and below at the interface pressure [R ~> kg m-3] real :: hbl_KPP ! The depth of the ocean boundary as used by KPP [m] real :: dz ! A thickness [Z ~> m] - real :: dh, hcorr ! Two thicknesses [m] + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] integer :: i, j, k g_o_rho0 = US%L_to_Z**2*US%s_to_T**2 * GV%g_Earth / GV%Rho0 @@ -213,12 +214,12 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) hcorr = 0.0 ! compute heights at cell center and interfaces do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, in the units used by CVMix. + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo ! gets index of the level and interface above hbl diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 413b87f631..6e2c76ba8d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -28,14 +28,14 @@ module MOM_CVMix_ddiff ! Parameters real :: strat_param_max !< maximum value for the stratification parameter [nondim] real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime - !! for salinity diffusion [m2 s-1] + !! for salinity diffusion [Z2 T-1 ~> m2 s-1] real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula [nondim] real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula [nondim] - real :: mol_diff !< molecular diffusivity [m2 s-1] + real :: mol_diff !< molecular diffusivity [Z2 T-1 ~> m2 s-1] real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime [nondim] real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime [nondim] real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime [nondim] - real :: min_thickness !< Minimum thickness allowed [m] + real :: min_thickness !< Minimum thickness allowed [Z ~> m] character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") logical :: debug !< If true, turn on debugging @@ -57,8 +57,8 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" if (associated(CS)) then call MOM_error(WARNING, "CVMix_ddiff_init called with an associated "// & @@ -82,7 +82,8 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & + units="m", scale=US%m_to_Z, default=0.001, do_not_log=.True.) call openParameterBlock(param_file,'CVMIX_DDIFF') @@ -91,8 +92,8 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) units="nondim", default=2.55) call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & - "Leading coefficient in formula for salt-fingering regime "//& - "for salinity diffusion.", units="m2 s-1", default=1.0e-4) + "Leading coefficient in formula for salt-fingering regime for salinity diffusion.", & + units="m2 s-1", default=1.0e-4, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & "Interior exponent in salt-fingering regime formula.", & @@ -116,7 +117,7 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MOL_DIFF", CS%mol_diff, & "Molecular diffusivity used in CVMix double diffusion.", & - units="m2 s-1", default=1.5e-6) + units="m2 s-1", default=1.5e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DIFF_CONV_TYPE", CS%diff_conv_type, & "type of diffusive convection to use. Options are Marmorino \n" //& @@ -126,10 +127,10 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call closeParameterBlock(param_file) call cvmix_init_ddiff(strat_param_max=CS%strat_param_max, & - kappa_ddiff_s=CS%kappa_ddiff_s, & + kappa_ddiff_s=US%Z2_T_to_m2_s*CS%kappa_ddiff_s, & ddiff_exp1=CS%ddiff_exp1, & ddiff_exp2=CS%ddiff_exp2, & - mol_diff=CS%mol_diff, & + mol_diff=US%Z2_T_to_m2_s*CS%mol_diff, & kappa_ddiff_param1=CS%kappa_ddiff_param1, & kappa_ddiff_param2=CS%kappa_ddiff_param2, & kappa_ddiff_param3=CS%kappa_ddiff_param3, & @@ -160,21 +161,21 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! Local variables real, dimension(SZK_(GV)) :: & cellHeight, & !< Height of cell centers [m] - dRho_dT, & !< partial derivatives of density wrt temp [R C-1 ~> kg m-3 degC-1] - dRho_dS, & !< partial derivatives of density wrt saln [R S-1 ~> kg m-3 ppt-1] + dRho_dT, & !< partial derivatives of density with temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & !< partial derivatives of density with salinity [R S-1 ~> kg m-3 ppt-1] pres_int, & !< pressure at each interface [R L2 T-2 ~> Pa] temp_int, & !< temp and at interfaces [C ~> degC] salt_int, & !< salt at at interfaces [S ~> ppt] alpha_dT, & !< alpha*dT across interfaces [kg m-3] beta_dS, & !< beta*dS across interfaces [kg m-3] - dT, & !< temp. difference between adjacent layers [C ~> degC] - dS !< salt difference between adjacent layers [S ~> ppt] + dT, & !< temperature difference between adjacent layers [C ~> degC] + dS !< salinity difference between adjacent layers [S ~> ppt] real, dimension(SZK_(GV)+1) :: & Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1]. Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1]. real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [m] - real :: dh, hcorr + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] integer :: i, k ! initialize dummy variables @@ -184,7 +185,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! GMM, I am leaving some code commented below. We need to pass BLD to - ! this soubroutine to avoid adding diffusivity above that. This needs + ! this subroutine to avoid adding diffusivity above that. This needs ! to be done once we re-structure the order of the calls. !if (.not. associated(hbl)) then ! allocate(hbl(SZI_(G), SZJ_(G))); @@ -234,16 +235,16 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) hcorr = 0.0 ! compute heights at cell center and interfaces do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in height units dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo ! gets index of the level and interface above hbl - !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j)) Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & @@ -277,7 +278,7 @@ logical function CVMix_ddiff_is_used(param_file) end function CVMix_ddiff_is_used -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory ! NOTE: Placeholder destructor subroutine CVMix_ddiff_end(CS) type(CVMix_ddiff_cs), pointer :: CS !< Control structure for this module that diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index e3906e9df2..708bb7c4fd 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -28,19 +28,19 @@ module MOM_CVMix_shear ! vary with the Boussinesq approximation, the Boussinesq variant is given first. !> Control structure including parameters for CVMix interior shear schemes. -type, public :: CVMix_shear_cs ! TODO: private +type, public :: CVMix_shear_cs ; private logical :: use_LMD94 !< Flags to use the LMD94 scheme logical :: use_PP81 !< Flags to use Pacanowski and Philander (JPO 1981) integer :: n_smooth_ri !< Number of times to smooth Ri using a 1-2-1 filter - real :: Ri_zero !< LMD94 critical Richardson number - real :: Nu_zero !< LMD94 maximum interior diffusivity - real :: KPP_exp !< Exponent of unitless factor of diff. - !! for KPP internal shear mixing scheme. + real :: Ri_zero !< LMD94 critical Richardson number [nondim] + real :: Nu_zero !< LMD94 maximum interior diffusivity [Z2 T-1 ~> m2 s-1] + real :: KPP_exp !< Exponent of unitless factor of diffusivities + !! for KPP internal shear mixing scheme [nondim] real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency [T-2 ~> s-2] - real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number + real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number [nondim] real, allocatable, dimension(:,:,:) :: ri_grad_orig !< Gradient Richardson number - !! before smoothing + !! after smoothing [nondim] character(10) :: Mix_Scheme !< Mixing scheme name (string) type(diag_ctrl), pointer :: diag => NULL() !< Pointer to the diagnostics control structure @@ -138,7 +138,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) S2 = US%L_to_Z**2*(DU*DU+DV*DV)/(DZ*DZ) Ri_Grad(k) = max(0., N2) / max(S2, 1.e-10*US%T_to_s**2) - ! fill 3d arrays, if user asks for diagsnostics + ! fill 3d arrays, if user asks for diagnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 @@ -273,22 +273,22 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "NU_ZERO", CS%Nu_Zero, & "Leading coefficient in KPP shear mixing.", & - units="nondim", default=5.e-3) + units="m2 s-1", default=5.e-3, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "RI_ZERO", CS%Ri_Zero, & "Critical Richardson for KPP shear mixing, "// & "NOTE this the internal mixing and this is "// & - "not for setting the boundary layer depth." & - ,units="nondim", default=0.8) + "not for setting the boundary layer depth.", & + units="nondim", default=0.8) call get_param(param_file, mdl, "KPP_EXP", CS%KPP_exp, & "Exponent of unitless factor of diffusivities, "// & - "for KPP internal shear mixing scheme." & - ,units="nondim", default=3.0) + "for KPP internal shear mixing scheme.", & + units="nondim", default=3.0) call get_param(param_file, mdl, "N_SMOOTH_RI", CS%n_smooth_ri, & "If > 0, vertically smooth the Richardson "// & "number by applying a 1-2-1 filter N_SMOOTH_RI times.", & - default = 0) + default=0) call cvmix_init_shear(mix_scheme=CS%Mix_Scheme, & - KPP_nu_zero=CS%Nu_Zero, & + KPP_nu_zero=US%Z2_T_to_m2_s*CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & KPP_exp=CS%KPP_exp) @@ -330,7 +330,7 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) end function CVMix_shear_init -!> Reads the parameters "LMD94" and "PP81" and returns state. +!> Reads the parameters "USE_LMD94" and "USE_PP81" and returns true if either is true. !! This function allows other modules to know whether this parameterization will !! be used without needing to duplicate the log entry. logical function CVMix_shear_is_used(param_file) @@ -338,13 +338,13 @@ logical function CVMix_shear_is_used(param_file) ! Local variables logical :: LMD94, PP81 call get_param(param_file, mdl, "USE_LMD94", LMD94, & - default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "Use_PP81", PP81, & - default=.false., do_not_log=.true.) + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_PP81", PP81, & + default=.false., do_not_log=.true.) CVMix_shear_is_used = (LMD94 .or. PP81) end function CVMix_shear_is_used -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory subroutine CVMix_shear_end(CS) type(CVMix_shear_cs), intent(inout) :: CS !< Control structure for this module that !! will be deallocated in this subroutine diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index ba47f281e8..01f8303ae2 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -37,13 +37,13 @@ module MOM_bkgnd_mixing ! Parameters real :: Bryan_Lewis_c1 !< The vertical diffusivity values for Bryan-Lewis profile - !! at |z|=D [m2 s-1] + !! at |z|=D [Z2 T-1 ~> m2 s-1] real :: Bryan_Lewis_c2 !< The amplitude of variation in diffusivity for the - !! Bryan-Lewis diffusivity profile [m2 s-1] + !! Bryan-Lewis diffusivity profile [Z2 T-1 ~> m2 s-1] real :: Bryan_Lewis_c3 !< The inverse length scale for transition region in the - !! Bryan-Lewis diffusivity profile [m-1] + !! Bryan-Lewis diffusivity profile [Z-1 ~> m-1] real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the - !! Bryan-Lewis profile [m] + !! Bryan-Lewis profile [Z ~> m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when @@ -57,11 +57,11 @@ module MOM_bkgnd_mixing real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the - !! Henyey scaling from the mixing + !! Henyey scaling from the mixing [nondim] real :: prandtl_bkgnd !< Turbulent Prandtl number used to convert - !! vertical background diffusivity into viscosity + !! vertical background diffusivity into viscosity [nondim] real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of - !! diffusivities with Kd_tanh_lat_fn. Valid values + !! diffusivities with Kd_tanh_lat_fn [nondim]. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] !! when no other physically based mixed layer turbulence @@ -116,7 +116,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL ! Local variables real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set Prandtl ! number unless it is provided as a parameter - real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. + real :: prandtl_bkgnd_comp ! Kv/CS%Kd [nondim]. Gets compared with user-specified prandtl_bkgnd. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -151,10 +151,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL CS%physical_OBL_scheme = physical_OBL_scheme if (CS%physical_OBL_scheme) then ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, default=-1., do_not_log=.true.) + call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, & + units="m2 s-1", default=-1., scale=US%m2_s_to_Z2_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KDML is a depricated parameter that should not be used.") - call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, default=-1., do_not_log=.true.) + call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & + units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KD_ML_TOT cannot be set when using a physically based ocean "//& "boundary layer mixing parameterization.") @@ -174,11 +176,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL if (abs(CS%Kd_tot_ml - CS%Kd) > 1.0e-15*abs(CS%Kd)) & call MOM_error(WARNING, "KDML is a depricated parameter. Use KD_ML_TOT instead.") endif - call log_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml*US%Z2_T_to_m2_s, & + call log_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & "The total diapcynal diffusivity in the surface mixed layer when there is "//& "not a physically based parameterization of mixing in the mixed layer, such "//& "as bulk mixed layer or KPP or ePBL.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, unscale=US%Z2_T_to_m2_s) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface "//& @@ -200,19 +202,19 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL call get_param(param_file, mdl, "BRYAN_LEWIS_C1", CS%Bryan_Lewis_c1, & "The vertical diffusivity values for Bryan-Lewis profile at |z|=D.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "BRYAN_LEWIS_C2", CS%Bryan_Lewis_c2, & "The amplitude of variation in diffusivity for the Bryan-Lewis profile", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "BRYAN_LEWIS_C3", CS%Bryan_Lewis_c3, & "The inverse length scale for transition region in the Bryan-Lewis profile", & - units="m-1", fail_if_missing=.true.) + units="m-1", scale=US%Z_to_m, fail_if_missing=.true.) call get_param(param_file, mdl, "BRYAN_LEWIS_C4", CS%Bryan_Lewis_c4, & "The depth where diffusivity is BRYAN_LEWIS_C1 in the Bryan-Lewis profile",& - units="m", fail_if_missing=.true.) + units="m", scale=US%m_to_Z, fail_if_missing=.true.) endif ! CS%Bryan_Lewis_diffusivity @@ -274,8 +276,8 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL "the Earth's rotation period, used with the Henyey "//& "scaling from the mixing.", units="nondim", default=20.0) call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) endif call get_param(param_file, mdl, "KD_TANH_LAT_FN", CS%Kd_tanh_lat_fn, & @@ -338,8 +340,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, real :: I_2Omega !< 1/(2 Omega) [T ~> s] real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim] real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim] - real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) - real :: deg_to_rad !< factor converting degrees to radians, pi/180. + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) [nondim] + real :: deg_to_rad !< factor converting degrees to radians [radians degree-1], pi/180. real :: abs_sinlat !< absolute value of sine of latitude [nondim] real :: min_sinlat ! The minimum value of the sine of latitude [nondim] real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1] @@ -367,10 +369,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, call CVMix_init_bkgnd(max_nlev=nz, & zw = depth_int(:), & !< interface depths relative to the surface in m, must be positive. - bl1 = CS%Bryan_Lewis_c1, & - bl2 = CS%Bryan_Lewis_c2, & - bl3 = CS%Bryan_Lewis_c3, & - bl4 = CS%Bryan_Lewis_c4, & + bl1 = US%Z2_T_to_m2_s*CS%Bryan_Lewis_c1, & + bl2 = US%Z2_T_to_m2_s*CS%Bryan_Lewis_c2, & + bl3 = US%m_to_Z*CS%Bryan_Lewis_c3, & + bl4 = US%Z_to_m*CS%Bryan_Lewis_c4, & prandtl = CS%prandtl_bkgnd) Kd_col(:) = 0.0 ; Kv_col(:) = 0.0 ! Is this line necessary? @@ -455,7 +457,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, enddo endif - ! Now set background diffusivies based on these surface values, possibly with vertical structure. + ! Now set background diffusivities based on these surface values, possibly with vertical structure. if ((.not.CS%physical_OBL_scheme) .and. (CS%Kd /= CS%Kd_tot_ml)) then ! This is a crude way to put in a diffusive boundary layer without an explicit boundary ! layer turbulence scheme. It should not be used for any realistic ocean models. @@ -527,7 +529,7 @@ subroutine check_bkgnd_scheme(CS, str) end subroutine -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory subroutine bkgnd_mixing_end(CS) type(bkgnd_mixing_cs), pointer :: CS !< Control structure for this module that !! will be deallocated in this subroutine diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 49d62bbde4..66e2dfa6b2 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -35,7 +35,7 @@ module MOM_bulk_mixed_layer integer :: nkbl !< The number of buffer layers. integer :: nsw !< The number of bands of penetrating shortwave radiation. real :: mstar !< The ratio of the friction velocity cubed to the - !! TKE input to the mixed layer, nondimensional. + !! TKE input to the mixed layer [nondim]. real :: nstar !< The fraction of the TKE input to the mixed layer !! available to drive entrainment [nondim]. real :: nstar2 !< The fraction of potential energy released by @@ -43,14 +43,18 @@ module MOM_bulk_mixed_layer logical :: absorb_all_SW !< If true, all shortwave radiation is absorbed by the !! ocean, instead of passing through to the bottom mud. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE - !! decay scale, nondimensional. + !! decay scale [nondim]. real :: bulk_Ri_ML !< The efficiency with which mean kinetic energy !! released by mechanically forced entrainment of !! the mixed layer is converted to TKE [nondim]. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE [nondim]. - real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. + real :: mech_TKE_floor !< A tiny floor on the amount of turbulent kinetic energy that is + !! used when the mixed layer does not yet contain HMIX_MIN fluid + !! [Z L2 T-2 ~> m3 s-2]. The default is so small that its actual + !! value is irrelevant, but it is detectably greater than 0. real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to !! avoid boiling the ocean. @@ -84,9 +88,9 @@ module MOM_bulk_mixed_layer integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective !! adjustment on this many layers (starting from the !! top) before sorting the remaining layers. - real :: omega_frac !< When setting the decay scale for turbulence, use - !! this fraction of the absolute rotation rate blended - !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + real :: omega_frac !< When setting the decay scale for turbulence, use this fraction + !! of the absolute rotation rate blended with the local value of f, + !! as sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. logical :: correct_absorption !< If true, the depth at which penetrating !! shortwave radiation is absorbed is corrected by !! moving some of the heating upward in the water @@ -105,9 +109,8 @@ module MOM_bulk_mixed_layer !! points of the surface region (mixed & buffer !! layer) thickness [nondim]. 0.5 by default. real :: lim_det_dH_bathy !< The fraction of the total depth by which the - !! thickness of the surface region (mixed & buffer - !! layer) is allowed to change between grid points. - !! Nondimensional, 0.2 by default. + !! thickness of the surface region (mixed & buffer layers) is allowed + !! to change between grid points [nondim]. 0.2 by default. logical :: use_river_heat_content !< If true, use the fluxes%runoff_Hflx field !! to set the heat carried by runoff, instead of !! using SST for temperature of liq_runoff @@ -118,21 +121,21 @@ module MOM_bulk_mixed_layer type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. real :: Allowed_T_chg !< The amount by which temperature is allowed - !! to exceed previous values during detrainment, K. + !! to exceed previous values during detrainment [C ~> degC] real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment [S ~> ppt] ! These are terms in the mixed layer TKE budget, all in [Z L2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. - diag_TKE_wind, & !< The wind source of TKE. - diag_TKE_RiBulk, & !< The resolved KE source of TKE. - diag_TKE_conv, & !< The convective source of TKE. - diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating. - diag_TKE_mech_decay, & !< The decay of mechanical TKE. - diag_TKE_conv_decay, & !< The decay of convective TKE. - diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. - diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. + diag_TKE_wind, & !< The wind source of TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_RiBulk, & !< The resolved KE source of TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_conv, & !< The convective source of TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_pen_SW, & !< The TKE sink required to mix penetrating shortwave heating [Z L2 T-3 ~> m3 s-3]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_conv_decay, & !< The decay of convective TKE [Z L2 T-3 ~> m3 s-3]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [Z L2 T-3 ~> m3 s-3]. + diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2 [Z L2 T-3 ~> m3 s-3]. diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer !! detrainment [R Z L2 T-3 ~> W m-2]. diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only @@ -171,10 +174,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! [L T-1 ~> m s-1]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent - !! fields have NULL ptrs. + !! fields have NULL pointers. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a @@ -184,7 +187,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C intent(inout) :: eb !< The amount of fluid moved upward into a !! layer; this should be increased due to !! mixed layer entrainment [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure type(optics_type), pointer :: optics !< The structure that can be queried for the !! inverse of the vertical absorption decay !! scale for penetrating shortwave radiation. @@ -195,7 +198,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! being applied separately. real, optional, intent(in) :: dt_diag !< The diagnostic time step, !! which may be less than dt if there are - !! two callse to mixedlayer [T ~> s]. + !! two calls to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< if true, this is the last call !! to mixedlayer in the current time step, so !! diagnostics will be written. The default is @@ -247,10 +250,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! entrained [C H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained ! [H S ~> m ppt or ppt kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + uhtot, & ! The depth integrated zonal velocity in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] + vhtot, & ! The depth integrated meridional velocity in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] - netMassInOut, & ! The net mass flux (if non-Boussinsq) or volume flux (if + netMassInOut, & ! The net mass flux (if non-Boussinesq) or volume flux (if ! Boussinesq - i.e. the fresh water flux (P+R-E)) into the ! ocean over a time step [H ~> m or kg m-2]. NetMassOut, & ! The mass flux (if non-Boussinesq) or volume flux (if Boussinesq) @@ -278,17 +281,17 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated ! over a time step in each band [C H ~> degC m or degC kg m-2]. real, dimension(max(CS%nsw,1),SZI_(G),SZK_(GV)) :: & - opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indicies are band, i, k. + opacity_band ! The opacity in each band [H-1 ~> m-1 or m2 kg-1]. The indices are band, i, k. real :: cMKE(2,SZI_(G)) ! Coefficients of HpE and HpE^2 used in calculating the ! denominator of MKE_rate; the two elements have differing ! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real :: Irho0 ! 1.0 / rho_0 [R-1 ~> m3 kg-1] - real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) + real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) [nondim] real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1]. - real :: RmixConst - + real :: RmixConst ! A combination of constants used in the river mixing energy + ! calculation [L2 T-2 R-2 ~> m8 s-2 kg-2] real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection ! [Z L2 T-2 ~> m3 s-2]. @@ -313,12 +316,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! layers before detrainment in to the interior [H ~> m or kg m-2]. max_BL_det ! If non-negative, the maximum amount of entrainment from ! the buffer layers that will be allowed this time step [H ~> m or kg m-2]. - real :: dHsfc, dHD ! Local copies of nondimensional parameters. + real :: dHsfc, dHD ! Local copies of nondimensional parameters [nondim] real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2]. real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. real :: kU_star ! Ustar times the Von Karman constant [Z T-1 ~> m s-1]. - real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. + real :: dt__diag ! A rescaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -341,9 +344,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) - Irho0 = 1.0 / (GV%Rho0) + Irho0 = 1.0 / GV%Rho0 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - Idt_diag = 1.0 / (dt__diag) + Idt_diag = 1.0 / dt__diag write_diags = .true. ; if (present(last_call)) write_diags = last_call p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref @@ -585,9 +588,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C enddo ; endif endif -! Move water left in the former mixed layer into the buffer layer and -! from the buffer layer into the interior. These steps might best be -! treated in conjuction. + ! Move water left in the former mixed layer into the buffer layer and + ! from the buffer layer into the interior. These steps might best be + ! treated in conjunction. if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & @@ -777,7 +780,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! [Z L2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment !! (perhaps CS%nkml). @@ -792,8 +795,8 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & ! entrained [C H ~> degC m or degC kg m-2]. Stot, & ! The integrated salt of layers which are fully entrained ! [H S ~> m ppt or ppt kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in - vhtot, & ! the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + uhtot, & ! The depth integrated zonal velocities in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] + vhtot, & ! The depth integrated meridional velocities in the mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1] KE_orig, & ! The total mean kinetic energy per unit area in the mixed layer before ! convection, [H L2 T-2 ~> m3 s-2 or kg s-2]. h_orig_k1 ! The depth of layer k1 before convective adjustment [H ~> m or kg m-2]. @@ -909,7 +912,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: T !< Layer temperatures [C ~> degC]. real, dimension(SZI_(G),SZK0_(GV)), & - intent(in) :: S !< Layer salinities [C ~> ppt]. + intent(in) :: S !< Layer salinities [S ~> ppt]. real, dimension(SZI_(G),SZK0_(GV)), & intent(in) :: R0 !< Potential density referenced to !! surface pressure [R ~> kg m-3]. @@ -952,13 +955,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent - !! fields have NULL ptrs. + !! fields have NULL pointers. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are @@ -981,13 +984,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! entrainment [H ~> m or kg m-2]. real :: h_ent ! The thickness from a layer that is entrained [H ~> m or kg m-2]. real :: T_precip ! The temperature of the precipitation [C ~> degC]. - real :: C1_3, C1_6 ! 1/3 and 1/6. - real :: En_fn, Frac, x1 ! Nondimensional temporary variables. + real :: C1_3, C1_6 ! 1/3 and 1/6 [nondim] + real :: En_fn, Frac, x1 ! Nondimensional temporary variables [nondim]. real :: dr, dr0 ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. real :: dr_ent, dr_comp ! Temporary variables [R H ~> kg m-2 or kg2 m-5]. real :: dr_dh ! The partial derivative of dr_ent with h_ent [R ~> kg m-3]. - real :: h_min, h_max ! The minimum, maximum, and previous estimates for - real :: h_prev ! h_ent [H ~> m or kg m-2]. + real :: h_min, h_max ! The minimum and maximum estimates for h_ent [H ~> m or kg m-2] + real :: h_prev ! The previous estimate for h_ent [H ~> m or kg m-2] real :: h_evap ! The thickness that is evaporated [H ~> m or kg m-2]. real :: dh_Newt ! The Newton's method estimate of the change in ! h_ent between iterations [H ~> m or kg m-2]. @@ -1002,7 +1005,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: Idt ! 1.0/dt [T-1 ~> s-1] integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & - C2, & ! Temporary variable R H-1 ~> kg m-4 or m-1]. + C2, & ! Temporary variable [R H-1 ~> kg m-4 or m-1]. r_SW_top ! Temporary variables [H R ~> kg m-2 or kg2 m-5]. Angstrom = GV%Angstrom_H @@ -1261,7 +1264,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! adjustment [H ~> m or kg m-2]. type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields - !! have NULL ptrs. + !! have NULL pointers. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in @@ -1290,8 +1293,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! time interval [T-1 ~> s-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. @@ -1448,7 +1451,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & intent(inout) :: d_eb !< The downward increase across a layer in the !! layer in the entrainment from below [H ~> m or kg m-2]. !! Positive values go with mass gain by a layer. - real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), intent(inout) :: htot !< The accumulated mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer temperature !! [C H ~> degC m or degC kg m-2]. real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer salinity @@ -1500,14 +1503,14 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & - intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure ! This subroutine calculates mechanically driven entrainment. ! Local variables real :: SW_trans ! The fraction of shortwave radiation that is not - ! absorbed in a layer, nondimensional. + ! absorbed in a layer [nondim]. real :: Pen_absorbed ! The amount of penetrative shortwave radiation ! that is absorbed in a layer [C H ~> degC m or degC kg m-2]. real :: h_avail ! The thickness in a layer available for entrainment [H ~> m or kg m-2]. @@ -1517,7 +1520,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: MKE_rate ! The fraction of the energy in resolved shears ! within the mixed layer that will be eliminated - ! within a timestep, nondim, 0 to 1. + ! within a timestep [nondim], 0 to 1. real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, @@ -1541,17 +1544,17 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & 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 :: dEF4_dh ! The partial derivative of EF4 with h [H-2 ~> m-2 or m4 kg-2]. - real :: Pen_En1 ! A nondimensional temporary variable. - real :: kh, exp_kh ! Nondimensional temporary variables related to the - real :: f1_kh ! fractional decay of TKE across a layer. - real :: x1, e_x1 ! Nondimensional temporary variables related to - real :: f1_x1, f2_x1 ! the relative decay of TKE and SW radiation across - real :: f3_x1 ! a layer, and exponential-related functions of x1. + real :: Pen_En1 ! A nondimensional temporary variable [nondim]. + real :: kh, exp_kh, f1_kh ! Nondimensional temporary variables related to the + ! fractional decay of TKE across a layer [nondim]. + real :: x1, e_x1 ! Nondimensional temporary variables related to the relative decay + ! of TKE and SW radiation across a layer [nondim] + real :: f1_x1, f2_x1, f3_x1 ! Exponential-related functions of x1 [nondim]. real :: E_HxHpE ! Entrainment divided by the product of the new and old ! thicknesses [H-1 ~> m-1 or m2 kg-1]. real :: Hmix_min ! The minimum mixed layer depth [H ~> m or kg m-2]. - real :: opacity - real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. + real :: opacity ! The opacity of a layer in a band of shortwave radiation [H-1 ~> m-1 or m2 kg-1] + real :: C1_3, C1_6, C1_24 ! 1/3, 1/6, and 1/24. [nondim] integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 @@ -1634,8 +1637,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif TKE(i) = TKE_full_ent - !### The minimum TKE value in this line may be problematically small. - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z*US%m_s_to_L_T**2 + + if (TKE(i) <= 0.0) TKE(i) = CS%mech_TKE_floor else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1784,12 +1787,12 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) !! the layers [R ~> kg m-3]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must !! remain in each layer [H ~> m or kg m-2]. - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. ! Local variables - real :: R0sort(SZI_(G),SZK_(GV)) - integer :: nsort(SZI_(G)) + real :: R0sort(SZI_(G),SZK_(GV)) ! The sorted potential density [R ~> kg m-3] + integer :: nsort(SZI_(G)) ! The number of layers left to sort logical :: done_sorting(SZI_(G)) integer :: i, k, ks, is, ie, nz, nkmb @@ -1852,14 +1855,14 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS !! layer in the entrainment from !! below [H ~> m or kg m-2]. Positive values go !! with mass gain by a layer. - integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. - type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control struct + integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), intent(in) :: CS !< Bulk mixed layer control structure real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced !! to the surface with potential !! temperature [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of - !! cpotential density referenced + !! potential density referenced !! to the surface with salinity, !! [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -1880,21 +1883,38 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS ! and the coordinate density (sigma-2)) between the newly forming mixed layer ! and a residual buffer- or mixed layer, and the number of massive layers above ! the deepest massive buffer or mixed layer is greater than nkbl, then split -! those buffer layers into peices that match the target density of the two +! those buffer layers into pieces that match the target density of the two ! nearest interior layers. ! Otherwise, if there are more than nkbl+1 remaining massive layers ! Local variables - real :: h_move, h_tgt_old, I_hnew - real :: dT_dS_wt2, dT_dR, dS_dR, I_denom - real :: Rcv_int - real :: T_up, S_up, R0_up, I_hup, h_to_up - real :: T_dn, S_dn, R0_dn, I_hdn, h_to_dn - real :: wt_dn - real :: dR1, dR2 - real :: dPE, hmin, min_dPE, min_hmin - real, dimension(SZK_(GV)) :: & - h_tmp, R0_tmp, T_tmp, S_tmp, Rcv_tmp + real :: h_move ! The thickness of water being moved between layers [H ~> m or kg m-2] + real :: h_tgt_old ! The previous thickness of the recipient layer [H ~> m or kg m-2] + real :: I_hnew ! The inverse of a new layer thickness [H-1 ~> m-1 or m2 kg-1] + real :: dT_dS_wt2 ! The square of the relative weighting of temperature and salinity changes + ! when extrapolating to match a target density [C2 S-2 ~> degC2 ppt-2] + real :: dT_dR ! The ratio of temperature changes to density changes when + ! extrapolating [C R-1 ~> degC m3 kg-1] + real :: dS_dR ! The ratio of salinity changes to density changes when + ! extrapolating [S R-1 ~> ppt m3 kg-1] + real :: I_denom ! A work variable with units of [S2 R-2 ~> ppt2 m6 kg-2]. + real :: Rcv_int ! The target coordinate density of an interior layer [R ~> kg m-3] + real :: T_up, T_dn ! Temperatures projected to match the target densities of two layers [C ~> degC] + real :: S_up, S_dn ! Salinities projected to match the target densities of two layers [S ~> ppt] + real :: R0_up, R0_dn ! Potential densities projected to match the target coordinate + ! densities of two layers [R ~> kg m-3] + real :: I_hup, I_hdn ! Inverse of the new thicknesses of the two layers [H-1 ~> m-1 or m2 kg-1] + real :: h_to_up, h_to_dn ! Thickness transferred to two layers [H ~> m or kg m-2] + real :: wt_dn ! Fraction of the thickness transferred to the deeper layer [nondim] + real :: dR1, dR2 ! Density difference with the target densities of two layers [R ~> kg m-3] + real :: dPE, min_dPE ! Values proportional to the potential energy change due to the merging + ! of a pair of layers [R H2 ~> kg m-1 or kg3 m-6] + real :: hmin, min_hmin ! The thickness of the thinnest layer [H ~> m or kg m-2] + real :: h_tmp(SZK_(GV)) ! A copy of the original layer thicknesses [H ~> m or kg m-2] + real :: R0_tmp(SZK_(GV)) ! A copy of the original layer potential densities [R ~> kg m-3] + real :: T_tmp(SZK_(GV)) ! A copy of the original layer temperatures [C ~> degC] + real :: S_tmp(SZK_(GV)) ! A copy of the original layer salinities [S ~> ppt] + real :: Rcv_tmp(SZK_(GV)) ! A copy of the original layer coordinate densities [R ~> kg m-3] integer :: ks_min logical :: sorted, leave_in_layer integer :: ks_deep(SZI_(G)), k_count(SZI_(G)), ks2_reverse(SZI_(G), SZK_(GV)) @@ -2168,13 +2188,13 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of !! potential density referenced to the !! surface with potential temperature, !! [R C-1 ~> kg m-3 degC-1]. real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of - !! cpotential density referenced to the + !! potential density referenced to the !! surface with salinity !! [R S-1 ~> kg m-3 ppt-1]. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -2224,10 +2244,11 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: stays_min_merge ! The minimum allowed value of stays_merge [H ~> m or kg m-2]. real :: dR0_2dz, dRcv_2dz ! Half the vertical gradients of R0 and Rcv [R H-1 ~> kg m-4 or m-1] -! real :: dT_2dz, dS_2dz ! Half the vertical gradients of T and S, in degC H-1, and ppt H-1. +! real :: dT_2dz ! Half the vertical gradient of T [C H-1 ~> degC m-1 or degC m2 kg-1] +! real :: dS_2dz ! Half the vertical gradient of S [S H-1 ~> ppt m-1 or ppt m2 kg-1] real :: scale_slope ! A nondimensional number < 1 used to scale down ! the slope within the upper buffer layer when - ! water MUST be detrained to the lower layer. + ! water MUST be detrained to the lower layer [nondim]. real :: dPE_extrap ! The potential energy change due to dispersive ! advection or mixing layers, divided by @@ -2241,13 +2262,16 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: h_det_h2 ! The amount of detrained water and mixed layer ! water that will go directly into the lower ! buffer layer [H ~> m or kg m-2]. - real :: h_det_to_h2, h_ml_to_h2 ! All of the variables hA_to_hB are the thickness fluxes - real :: h_det_to_h1, h_ml_to_h1 ! from one layer to another [H ~> m or kg m-2], - real :: h1_to_h2, h1_to_k0 ! with h_det the detrained water, h_ml - real :: h2_to_k1, h2_to_k1_rem ! the actively mixed layer, h1 and h2 the upper - ! and lower buffer layers, and k0 and k1 the - ! interior layers that are just lighter and - ! just denser than the lower buffer layer. + + real :: h_det_to_h2, h_ml_to_h2 ! The fluxes of detrained and mixed layer water to + ! the lower buffer layer [H ~> m or kg m-2]. + real :: h_det_to_h1, h_ml_to_h1 ! The fluxes of detrained and mixed layer water to + ! the upper buffer layer [H ~> m or kg m-2]. + real :: h1_to_h2, h1_to_k0 ! The fluxes of upper buffer layer water to the lower buffer layer + ! and to an interior layer that is just denser than the lower + ! buffer layer [H ~> m or kg m-2]. + real :: h2_to_k1, h2_to_k1_rem ! Fluxes of lower buffer layer water to the interior layer that + ! is just denser than the lower buffer layer [H ~> m or kg m-2]. real :: R0_det, T_det, S_det ! Detrained values of R0 [R ~> kg m-3], T [C ~> degC] and S [S ~> ppt] real :: Rcv_stays, R0_stays ! Values of Rcv and R0 that stay in a layer [R ~> kg m-3] @@ -2264,9 +2288,9 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: dPE_ratio ! Multiplier of dPE_det at which merging is ! permitted - here (detrainment_per_day/dt)*30 - ! days? + ! days? [nondim] real :: num_events ! The number of detrainment events over which - ! to prefer merging the buffer layers. + ! to prefer merging the buffer layers [nondim]. real :: dPE_time_ratio ! Larger of 1 and the detrainment timescale over dt [nondim]. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in @@ -2287,14 +2311,16 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables [nondim] - real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables, - real :: Ihk0, Ihk1, Ih12 ! all in [H-1 ~> m-1 or m2 kg-1]. - real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables, - real :: dR0, dR21, dRcv ! all in [R ~> kg m-3]. + real :: Ih, Ihdet, Ih1f, Ih2f ! Assorted inverse thickness work variables [H-1 ~> m-1 or m2 kg-1] + real :: Ihk0, Ihk1, Ih12 ! Assorted inverse thickness work variables [H-1 ~> m-1 or m2 kg-1] + real :: dR1, dR2, dR2b, dRk1 ! Assorted density difference work variables [R ~> kg m-3] + real :: dR0, dR21, dRcv ! Assorted density difference work variables [R ~> kg m-3] real :: dRcv_stays, dRcv_det, dRcv_lim ! Assorted densities [R ~> kg m-3] - real :: Angstrom ! The minumum layer thickness [H ~> m or kg m-2]. + real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. - real :: h2_to_k1_lim, T_new, S_new, T_max, T_min, S_max, S_min + real :: h2_to_k1_lim ! A limit on the thickness that can be detrained to layer k1 [H ~> m or kg m-2] + real :: T_new, T_max, T_min ! Temperature of the detrained water and limits on it [C ~> degC] + real :: S_new, S_max, S_min ! Salinity of the detrained water and limits on it [S ~> ppt] integer :: i, k, k0, k1, is, ie, nz, kb1, kb2, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke @@ -2352,7 +2378,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! (3) The lower buffer layer density extrapolated to its base with a ! linear fit between the two layers must exceed the density of the ! next denser interior layer. - ! (4) The average extroplated coordinate density that is moved into the + ! (4) The average extrapolated coordinate density that is moved into the ! isopycnal interior matches the target value for that layer. ! (5) The potential energy change is calculated and might be used later ! to allow the upper buffer layer to mix more into the lower buffer @@ -2387,7 +2413,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, R0(i,kb2) = R0(i,kb1) - Rcv(i,kb2)=Rcv(i,kb1) ; T(i,kb2)=T(i,kb1) ; S(i,kb2)=S(i,kb1) + Rcv(i,kb2) = Rcv(i,kb1) ; T(i,kb2) = T(i,kb1) ; S(i,kb2) = S(i,kb1) if (k1 <= nz) then ; if (R0(i,k1) >= R0(i,kb1)) then @@ -3062,7 +3088,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! a layer. integer, intent(in) :: j !< The meridional row to work on. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of !! coordinate defining potential density !! with potential temperature @@ -3081,9 +3107,17 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. - real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 + real :: dT_dS_wt2 ! The square of the relative weighting of temperature and salinity changes + ! when extraploating to match a target density [C2 S-2 ~> degC2 ppt-2] + real :: dT_dR ! The ratio of temperature changes to density changes when + ! extrapolating [C R-1 ~> degC m3 kg-1] + real :: dS_dR ! The ratio of salinity changes to density changes when + ! extrapolating [S R-1 ~> ppt m3 kg-1] + real :: dRml ! The density range within the extent of the mixed layers [R ~> kg m-3] + real :: dR0_dRcv ! The relative changes in the potential density and the coordinate density [nondim] real :: I_denom ! A work variable [S2 R-2 ~> ppt2 m6 kg-2]. - real :: Sdown, Tdown ! A salinity [S ~> ppt] and a temperature [C ~> degC] + real :: Sdown ! The salinity of the detrained water [S ~> ppt] + real :: Tdown ! The temperature of the detrained water [C ~> degC] real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time @@ -3091,11 +3125,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: g_H2_2dt ! Half the gravitational acceleration times the square of the ! conversion from H to Z divided by the diagnostic time step ! [L2 Z H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. - + real :: x1 ! A temporary work variable [various] logical :: splittable_BL(SZI_(G)), orthogonal_extrap - real :: x1 - integer :: i, is, ie, k, k1, nkmb, nz + is = G%isc ; ie = G%iec ; nz = GV%ke nkmb = CS%nkml+CS%nkbl if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & @@ -3149,9 +3182,8 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e ! the released buoyancy. With multiple buffer layers, much more ! graceful options are available. do i=is,ie ; if (h(i,nkmb) > 0.0) then - if ((R0(i,0) & - (R0(i,nkmb)-R0(i,nz))*h(i,nkmb)) then + if ((R0(i,0) < R0(i,nz)) .and. (R0(i,nz) < R0(i,nkmb))) then + if ((R0(i,nz)-R0(i,0))*h(i,0) > (R0(i,nkmb)-R0(i,nz))*h(i,nkmb)) then detrain(i) = (R0(i,nkmb)-R0(i,nz))*h(i,nkmb) / (R0(i,nkmb)-R0(i,0)) else detrain(i) = (R0(i,nz)-R0(i,0))*h(i,0) / (R0(i,nkmb)-R0(i,0)) @@ -3194,7 +3226,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e do k=nz-1,nkmb+1,-1 ; do i=is,ie if (splittable_BL(i)) then - if (RcvTgt(k)<=Rcv(i,nkmb)) then + if (RcvTgt(k) <= Rcv(i,nkmb)) then ! Estimate dR/drho, dTheta/dR, and dS/dR, where R is the coordinate variable ! and rho is in-situ (or surface) potential density. ! There is no "right" way to do this, so this keeps things reasonable, if @@ -3294,7 +3326,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e CS%diag_PE_detrain(i,j) - g_H2_2dt * detrain(i) * dR0_dRcv * & (h(i,nkmb)-detrain(i)) * (RcvTgt(k+1) - Rcv(i,nkmb) + dRml) endif - endif ! RcvTgt(k)<=Rcv(i,nkmb) + endif ! (RcvTgt(k) <= Rcv(i,nkmb)) endif ! splittable_BL enddo ; enddo ! i & k loops @@ -3329,13 +3361,14 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control struct + type(bulkmixedlayer_CS), intent(inout) :: CS !< Bulk mixed layer control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. - real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] - real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m + real :: omega_frac_dflt ! The default value for ML_OMEGA_FRAC [nondim] + real :: ustar_min_dflt ! The default value for BML_USTAR_MIN [Z T-1 ~> m s-1] + real :: Hmix_min_z ! The default value of HMIX_MIN [Z ~> m] integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3368,8 +3401,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "BULK_RI_ML", CS%bulk_Ri_ML, & "The efficiency with which mean kinetic energy released "//& "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy.", units="nondim",& - fail_if_missing=.true.) + "is converted to turbulent kinetic energy.", & + units="nondim", fail_if_missing=.true.) call get_param(param_file, mdl, "ABSORB_ALL_SW", CS%absorb_all_sw, & "If true, all shortwave radiation is absorbed by the "//& "ocean, instead of passing through to the bottom mud.", & @@ -3381,8 +3414,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "NSTAR2", CS%nstar2, & "The portion of any potential energy released by "//& "convective adjustment that is available to drive "//& - "entrainment at the base of mixed layer. By default "//& - "NSTAR2=NSTAR.", units="nondim", default=CS%nstar) + "entrainment at the base of mixed layer. By default NSTAR2=NSTAR.", & + units="nondim", default=CS%nstar) call get_param(param_file, mdl, "BULK_RI_CONVECTIVE", CS%bulk_Ri_convective, & "The efficiency with which convectively released mean "//& "kinetic energy is converted to turbulent kinetic "//& @@ -3391,10 +3424,16 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & 'The value the von Karman constant as used for mixed layer viscosity.', & units='nondim', default=0.41) - call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & + call get_param(param_file, mdl, "HMIX_MIN", Hmix_min_Z, & "The minimum mixed layer depth if the mixed layer depth "//& - "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & - unscaled=Hmix_min_m) + "is determined dynamically.", units="m", default=0.0, scale=US%m_to_Z) + CS%Hmix_min = GV%Z_to_H * Hmix_min_Z + call get_param(param_file, mdl, "MECH_TKE_FLOOR", CS%mech_TKE_floor, & + "A tiny floor on the amount of turbulent kinetic energy that is used when "//& + "the mixed layer does not yet contain HMIX_MIN fluid. The default is so "//& + "small that its actual value is irrelevant, so long as it is greater than 0.", & + units="m3 s-2", default=1.0e-150, scale=US%m_to_Z*US%m_s_to_L_T**2, & + do_not_log=(Hmix_min_Z<=0.0)) call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers "//& @@ -3418,7 +3457,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "relative to the density range within the mixed and "//& "buffer layers, when the detrainment is going into the "//& "lightest interior layer, nondimensional, or a negative "//& - "value not to apply this limit.", units="nondim", default = -1.0) + "value not to apply this limit.", units="nondim", default=-1.0) call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_THICK", CS%Hbuffer_min, & "The minimum buffer layer thickness when the mixed layer is very thick.", & units="m", default=5.0, scale=GV%m_to_H) @@ -3426,10 +3465,15 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "The minimum buffer layer thickness relative to the combined mixed "//& "land buffer ayer thicknesses when they are thin.", & units="nondim", default=0.1/CS%nkbl) - BL_detrain_time_dflt = 4.0*3600.0 ; if (CS%nkbl==1) BL_detrain_time_dflt = 86400.0*30.0 - call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + if (CS%nkbl==1) then + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + "A timescale that characterizes buffer layer detrainment events.", & + units="s", default=86400.0*30.0, scale=US%s_to_T) + else + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & "A timescale that characterizes buffer layer detrainment events.", & - units="s", default=BL_detrain_time_dflt, scale=US%s_to_T) + units="s", default=4.0*3600.0, scale=US%s_to_T) + endif call get_param(param_file, mdl, "BUFFER_SPLIT_RHO_TOL", CS%BL_split_rho_tol, & "The fractional tolerance for matching layer target densities when splitting "//& "layers to deal with massive interior layers that are lighter than one of the "//& @@ -3438,7 +3482,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean "//& "depth is less than DEPTH_LIMIT_FLUXES.", & - units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) + units="m", default=0.1*US%Z_to_m*Hmix_min_z, scale=GV%m_to_H) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", & default=7.2921e-5, units="s-1", scale=US%T_to_s) @@ -3465,12 +3509,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*US%s_to_T*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the "//& "bulk mixed layer model in setting vertical TKE decay "//& - "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) + "scales. This must be greater than 0.", & + units="m s-1", default=US%Z_to_m*US%s_to_T*ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3600,7 +3644,7 @@ function EF4(Ht, En, I_L, dR_de) real :: EF4 !< The integral [H-1 ~> m-1 or m2 kg-1]. ! Local variables - real :: exp_LHpE ! A nondimensional exponential decay. + real :: exp_LHpE ! A nondimensional exponential decay [nondim]. real :: I_HpE ! An inverse thickness plus entrainment [H-1 ~> m-1 or m2 kg-1]. real :: Res ! The result of the integral above [H-1 ~> m-1 or m2 kg-1]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index a3450bd6e4..ba8ba0b805 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -43,6 +43,8 @@ module MOM_diabatic_aux logical :: do_rivermix = .false. !< Provide additional TKE to mix river runoff at the !! river mouths to a depth of "rivermix_depth" real :: rivermix_depth = 0.0 !< The depth to which rivers are mixed if do_rivermix = T [Z ~> m]. + real :: dSalt_frac_max !< An upper limit on the fraction of the salt in a layer that can be + !! lost to the net surface salt fluxes within a timestep [nondim] 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 true. @@ -220,7 +222,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) end subroutine make_frazil !> This subroutine applies double diffusion to T & S, assuming no diapycnal mass -!! fluxes, using a simple triadiagonal solver. +!! fluxes, using a simple tridiagonal solver. subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -242,20 +244,19 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, dt, G, GV) ! local variables real, dimension(SZI_(G)) :: & - b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. - d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim]. + b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S [H ~> m or kg m-2]. + d1_T, d1_S ! Variables used by the tridiagonal solvers [nondim]. real, dimension(SZI_(G),SZK_(GV)) :: & - c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. + c1_T, c1_S ! Variables used by the tridiagonal solvers [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)+1) :: & - mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2]. - real :: h_tr ! h_tr is h at tracer points with a tiny thickness - ! added to ensure positive definiteness [H ~> m or kg m-2]. - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: I_h_int ! The inverse of the thickness associated with an - ! interface [H-1 ~> m-1 or m2 kg-1]. - real :: b_denom_T ! The first term in the denominators for the expressions - real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. + mix_T, mix_S ! Mixing distances in both directions across each interface [H ~> m or kg m-2]. + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness [H ~> m or kg m-2]. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: I_h_int ! The inverse of the thickness associated with an interface [H-1 ~> m-1 or m2 kg-1]. + real :: b_denom_T ! The first term in the denominator for the expression for b1_T [H ~> m or kg m-2]. + real :: b_denom_S ! The first term in the denominator for the expression for b1_S [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -497,17 +498,18 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) !! v_h as though ea and eb were being supplied with !! uniformly zero values. - ! local variables + ! Local variables real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: b1(SZI_(G)) ! A thickness used in the tridiagonal solver [H ~> m or kg m-2] real :: c1(SZI_(G),SZK_(GV)) ! A variable used in the tridiagonal solver [nondim] real :: d1(SZI_(G)) ! The complement of c1 [nondim] - real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring - real :: a_e(SZI_(G)), a_w(SZI_(G)) ! velocity points, ~1/2 in the open - ! ocean, nondimensional. - real :: sum_area, Idenom + ! Fractional weights of the neighboring velocity points, ~1/2 in the open ocean. + real :: a_n(SZI_(G)), a_s(SZI_(G)) ! Fractional weights of the neighboring velocity points [nondim] + real :: a_e(SZI_(G)), a_w(SZI_(G)) ! Fractional weights of the neighboring velocity points [nondim] + real :: sum_area ! A sum of adjacent areas [L2 ~> m2] + real :: Idenom ! The inverse of the denominator in a weighted average [L-2 ~> m-2] logical :: mix_vertically, zero_mixing integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -527,6 +529,12 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) do i=is,ie sum_area = G%areaCu(I-1,j) + G%areaCu(I,j) if (sum_area > 0.0) then + ! If this were a simple area weighted average, this would just be I_denom = 1.0 / sum_area. + ! The other factor of sqrt(0.5*sum_area*G%IareaT(i,j)) is 1 for open ocean points on a + ! Cartesian grid. This construct predates the initial commit of the MOM6 code, and was + ! present in the GOLD code before February, 2010. I do not recall why this was added, and + ! the GOLD CVS server that contained the relevant history and logs appears to have been + ! decommissioned. Idenom = sqrt(0.5*G%IareaT(i,j) / sum_area) a_w(i) = G%areaCu(I-1,j) * Idenom a_e(i) = G%areaCu(I,j) * Idenom @@ -588,12 +596,15 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, US, ea, eb, zero_mix) call cpu_clock_end(id_clock_uv_at_h) end subroutine find_uv_at_h - +!> Estimate the optical properties of the water column and determine the penetrating shortwave +!! radiation by band, extracting the relevant information from the fluxes type and storing it +!! in the optics type for later application. This routine is effectively a wrapper for +!! set_opacity with added error handling and diagnostics. subroutine set_pen_shortwave(optics, fluxes, G, GV, US, CS, opacity, tracer_flow_CSp) type(optics_type), pointer :: optics !< An optics structure that has will contain !! information about shortwave fluxes and absorption. type(forcing), intent(inout) :: fluxes !< points to forcing fields - !! unused fields have NULL ptrs + !! unused fields have NULL pointers 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 @@ -688,12 +699,21 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ - id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%L_to_Z**2*GV%g_Earth / (GV%Rho0) - dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML + id_N2 = -1 + if (present(id_N2subML)) then + if (present(dz_subML)) then + id_N2 = id_N2subML + dH_subML = GV%Z_to_H*dz_subML + else + call MOM_error(FATAL, "When the diagnostic of the subML stratification is "//& + "requested by providing id_N2_subML to diagnoseMLDbyDensityDifference, "//& + "the distance over which to calculate that distance must also be provided.") + endif + endif + + gE_rho0 = US%L_to_Z**2*GV%g_Earth / GV%Rho0 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -722,10 +742,10 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, ! the cells that extend over at least dz_subML. if (id_N2>0) then do i=is,ie - if (MLD(i,j)==0.0) then ! Still in the mixed layer. + if (MLD(i,j) == 0.0) then ! Still in the mixed layer. H_subML(i) = H_subML(i) + h(i,j,k) elseif (.not.N2_region_set(i)) then ! This block is below the mixed layer, but N2 has not been found yet. - if (dH_N2(i)==0.0) then ! Record the temperature, salinity, pressure, immediately below the ML + if (dH_N2(i) == 0.0) then ! Record the temperature, salinity, pressure, immediately below the ML T_subML(i) = tv%T(i,j,k) ; S_subML(i) = tv%S(i,j,k) H_subML(i) = H_subML(i) + 0.5 * h(i,j,k) ! Start midway through this layer. dH_N2(i) = 0.5 * h(i,j,k) @@ -746,8 +766,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, do i = is, ie deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface ddRho = deltaRhoAtK(i) - deltaRhoAtKm1(i) - if ((MLD(i,j)==0.) .and. (ddRho>0.) .and. & - (deltaRhoAtKm1(i)=densityDiff)) then + if ((MLD(i,j) == 0.) .and. (ddRho > 0.) .and. & + (deltaRhoAtKm1(i) < densityDiff) .and. (deltaRhoAtK(i) >= densityDiff)) then aFac = ( densityDiff - deltaRhoAtKm1(i) ) / ddRho MLD(i,j) = dK(i) * aFac + dKm1(i) * (1. - aFac) endif @@ -755,7 +775,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo ! i-loop enddo ! k-loop do i=is,ie - if ((MLD(i,j)==0.) .and. (deltaRhoAtK(i)0) then ! Now actually calculate stratification, N2, below the mixed layer. @@ -803,7 +823,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) ! converges extremely quickly (usually 1 guess) since this equation turns out to be rather ! linear for PE change with increasing X. ! Input parameters: - integer, dimension(3), intent(in) :: id_MLD !< Energy output diag IDs + integer, dimension(3), intent(in) :: id_MLD !< Energy output diagnostic IDs type(ocean_grid_type), intent(in) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1045,13 +1065,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Local variables integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) - real :: H_limit_fluxes - real :: IforcingDepthScale + real :: H_limit_fluxes ! Surface fluxes are scaled down fluxes when the total depth of the ocean + ! drops below this value [H ~> m or kg m-2] + real :: IforcingDepthScale ! The inverse of the layer thickness below which mass losses are + ! shifted to the next deeper layer [H ~> m or kg m-2] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: dThickness, dTemp, dSalt - real :: fractionOfForcing, hOld, Ithickness + real :: dThickness ! The change in layer thickness [H ~> m or kg m-2] + real :: dTemp ! The integrated change in layer temperature [C H ~> degC m or degC kg m-2] + real :: dSalt ! The integrated change in layer salinity [S H ~> ppt m or ppt kg m-2] + real :: fractionOfForcing ! THe fraction of the remaining forcing applied to a layer [nondim] + real :: hOld ! The original thickness of a layer [H ~> m or kg m-2] + real :: Ithickness ! The inverse of the new layer thickness [H-1 ~> m-1 or m2 kg-1] real :: RivermixConst ! A constant used in implementing river mixing [R Z2 T-1 ~> Pa s]. - real :: EnthalpyConst ! A constant used to control the enthalpy calculation + real :: EnthalpyConst ! A constant used to control the enthalpy calculation [nondim] ! By default EnthalpyConst = 1.0. If fluxes%heat_content_evap ! is associated enthalpy is provided via coupler and EnthalpyConst = 0.0. real, dimension(SZI_(G)) :: & @@ -1092,13 +1118,17 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency ! band of shortwave radiation in each layer [H-1 ~> m-1 or m2 kg-1] real, dimension(maxGroundings) :: hGrounding ! Thickness added by each grounding event [H ~> m or kg m-2] - real :: Temp_in, Salin_in + real :: Temp_in ! The initial temperature of a layer [C ~> degC] + real :: Salin_in ! The initial salinity of a layer [S ~> ppt] real :: g_Hconv2 ! A conversion factor for use in the TKE calculation ! in units of [Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. real :: GoRho ! g_Earth times a unit conversion factor divided by density ! [Z T-2 R-1 ~> m4 s-2 kg-1] - logical :: calculate_energetics - logical :: calculate_buoyancy + logical :: calculate_energetics ! If true, calculate the energy required to mix the newly added + ! water over the topmost grid cell, assuming that the fluxes of heat and salt + ! and rejected brine are initially applied in vanishingly thin layers at the + ! top of the layer before being mixed throughout the layer. + logical :: calculate_buoyancy ! If true, calculate the surface buoyancy flux. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, nb character(len=45) :: mesg @@ -1130,7 +1160,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom_H, 1.0e-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, GV%H_subroundoff) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. @@ -1268,7 +1298,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! B/ update mass, salt, temp from mass leaving ocean. ! C/ update temp due to penetrative SW do i=is,ie - if (G%mask2dT(i,j)>0.) then + if (G%mask2dT(i,j) > 0.) then ! A/ Update mass, temp, and salinity due to incoming mass flux. do k=1,1 @@ -1308,7 +1338,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! where River is in units of [Z T-1 ~> m s-1]. ! Samb = Ambient salinity at the mouth of the estuary ! rivermix_depth = The prescribed depth over which to mix river inflow - ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. + ! drho_ds = The derivative of density with salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) if (GV%Boussinesq) then RivermixConst = -0.5*(CS%rivermix_depth*dt) * ( US%L_to_Z**2*GV%g_Earth ) * GV%Rho0 @@ -1359,8 +1389,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) dTemp = fractionOfForcing*netHeat(i) - ! ### The 0.9999 here should become a run-time parameter? - dSalt = max( fractionOfForcing*netSalt(i), -0.9999*h2d(i,k)*tv%S(i,j,k)) + dSalt = max( fractionOfForcing*netSalt(i), -CS%dSalt_frac_max * h2d(i,k) * tv%S(i,j,k)) ! Update the forcing by the part to be consumed within the present k-layer. ! If fractionOfForcing = 1, then new netMassOut vanishes. @@ -1416,7 +1445,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t enddo ! k ! Check if trying to apply fluxes over land points - elseif ((abs(netHeat(i))+abs(netSalt(i))+abs(netMassIn(i))+abs(netMassOut(i)))>0.) then + elseif ((abs(netHeat(i)) + abs(netSalt(i)) + abs(netMassIn(i)) + abs(netMassOut(i))) > 0.) then if (.not. CS%ignore_fluxes_over_land) then call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (land)') @@ -1554,7 +1583,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t if (CS%id_nonpenSW_diag > 0) call post_data(CS%id_nonpenSW_diag , CS%nonpenSW_diag , CS%diag) ! The following check will be ignored if ignore_fluxes_over_land = true - if (numberOfGroundings>0 .and. .not. CS%ignore_fluxes_over_land) then + if ((numberOfGroundings > 0) .and. .not.CS%ignore_fluxes_over_land) then do i = 1, min(numberOfGroundings, maxGroundings) call forcing_SinglePointPrint(fluxes,G,iGround(i),jGround(i),'applyBoundaryFluxesInOut (grounding)') write(mesg(1:45),'(3es15.3)') G%geoLonT( iGround(i), jGround(i) ), & @@ -1588,8 +1617,8 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori !! boundary layer scheme to determine the diffusivity !! in the surface boundary layer. -! 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_aux" ! This module's name. character(len=200) :: inputdir ! The directory where NetCDF input files character(len=240) :: chl_filename ! A file from which chl_a concentrations are to be read. @@ -1617,28 +1646,31 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori "The following parameters are used for auxiliary diabatic processes.") call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & - "If true, temperature and salinity are used as state "//& - "variables.", default=.true.) + "If true, temperature and salinity are used as state variables.", default=.true.) call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any "//& "overlying layers down to the freezing point, thereby "//& "avoiding the creation of thin ice when the SST is above "//& - "the freezing point.", default=.true.) - call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", & - CS%pressure_dependent_frazil, & + "the freezing point.", default=.true., do_not_log=.not.use_temperature) + call get_param(param_file, mdl, "SALT_EXTRACTION_LIMIT", CS%dSalt_frac_max, & + "An upper limit on the fraction of the salt in a layer that can be lost to the "//& + "net surface salt fluxes within a timestep.", & + units="nondim", default=0.9999, do_not_log=.not.use_temperature) + CS%dSalt_frac_max = max(min(CS%dSalt_frac_max, 1.0), 0.0) + call get_param(param_file, mdl, "PRESSURE_DEPENDENT_FRAZIL", CS%pressure_dependent_frazil, & "If true, use a pressure dependent freezing temperature "//& "when making frazil. The default is false, which will be "//& "faster but is inappropriate with ice-shelf cavities.", & - default=.false.) + default=.false., do_not_log=.not.use_temperature) if (use_ePBL) then call get_param(param_file, mdl, "IGNORE_FLUXES_OVER_LAND", CS%ignore_fluxes_over_land,& - "If true, the model does not check if fluxes are being applied "//& - "over land points. This is needed when the ocean is coupled "//& - "with ice shelves and sea ice, since the sea ice mask needs to "//& - "be different than the ocean mask to avoid sea ice formation "//& - "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) + "If true, the model does not check if fluxes are being applied "//& + "over land points. This is needed when the ocean is coupled "//& + "with ice shelves and sea ice, since the sea ice mask needs to "//& + "be different than the ocean mask to avoid sea ice formation "//& + "under ice shelves. This flag only works when use_ePBL = True.", default=.false.) call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & "If true, apply additional mixing wherever there is "//& "runoff, so that it is mixed down to RIVERMIX_DEPTH "//& @@ -1655,11 +1687,11 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & - default=.false.) + default=.false., do_not_log=.not.use_temperature) call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & "If true, use the fluxes%calving_Hflx field to set the "//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & - default=.false.) + default=.false., do_not_log=.not.use_temperature) else CS%use_river_heat_content = .false. CS%use_calving_heat_content = .false. @@ -1753,32 +1785,45 @@ end subroutine diabatic_aux_end !> \namespace mom_diabatic_aux !! -!! This module contains the subroutines that, along with the -!! subroutines that it calls, implements diapycnal mass and momentum -!! fluxes and a bulk mixed layer. The diapycnal diffusion can be -!! used without the bulk mixed layer. +!! This module contains subroutines that apply various diabatic processes. Usually these +!! subroutines are called from the MOM_diabatic module. All of these routines use appropriate +!! limiters or logic to work properly with arbitrary layer thicknesses (including massless layers) +!! and an arbitrarily large timestep. +!! +!! The subroutine make_frazil facilitates the formation of frazil ice when the ocean water +!! drops below the in situ freezing point by heating the water to the freezing point and +!! accumulating the required heat for exchange with the sea-ice module. +!! +!! The subroutine adjust_salt adds salt as necessary to keep the salinity above a +!! specified minimum value, and keeps track of the cumulative additions. If the minimum +!! salinity is the natural value of 0, this routine should never do anything. +!! +!! The subroutine differential_diffuse_T_S solves a pair of tridiagonal equations for +!! the diffusion of temperatures and salinities with differing diffusivities. +!! +!! The subroutine triDiagTS solves a tridiagonal equations for the evolution of temperatures +!! and salinities due to net entrainment by layers and a diffusion with the same diffusivity. +!! +!! The subroutine triDiagTS_Eulerian solves a tridiagonal equations for the evolution of +!! temperatures and salinities due to diffusion with the same diffusivity, but no net entrainment. +!! +!! The subroutine find_uv_at_h interpolates velocities to thickness points, optionally also +!! using tridiagonal equations to solve for the impacts of net entrainment or mixing of +!! momentum between layers. +!! +!! The subroutine set_pen_shortwave determines the optical properties of the water column and +!! the net shortwave fluxes, and stores them in the optics type, working via calls to set_opacity. +!! +!! The subroutine diagnoseMLDbyDensityDifference diagnoses a mixed layer depth based on a +!! density difference criterion, and may also estimate the stratification of the water below +!! this diagnosed mixed layer. !! -!! diabatic first determines the (diffusive) diapycnal mass fluxes -!! based on the convergence of the buoyancy fluxes within each layer. -!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, -!! 1997) is used for combined diapycnal advection and diffusion, -!! calculated implicitly and potentially with the Richardson number -!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal -!! advection is fundamentally the residual of diapycnal diffusion, -!! so the fully implicit upwind differencing scheme that is used is -!! entirely appropriate. The downward buoyancy flux in each layer -!! is determined from an implicit calculation based on the previously -!! calculated flux of the layer above and an estimated flux in the -!! layer below. This flux is subject to the following conditions: -!! (1) the flux in the top and bottom layers are set by the boundary -!! conditions, and (2) no layer may be driven below an Angstrom thick- -!! ness. If there is a bulk mixed layer, the buffer layer is treat- -!! ed as a fixed density layer with vanishingly small diffusivity. +!! The subroutine diagnoseMLDbyEnergy diagnoses a mixed layer depth based on a mixing-energy +!! criterion, as described by Reichl et al., 2022, JGR: Oceans, doi:10.1029/2021JC018140. !! -!! diabatic takes 5 arguments: the two velocities (u and v), the -!! thicknesses (h), a structure containing the forcing fields, and -!! the length of time over which to act (dt). The velocities and -!! thickness are taken as inputs and modified within the subroutine. -!! There is no limit on the time step. +!! The subroutine applyBoundaryFluxesInOut updates the layer thicknesses, temperatures and +!! salinities due to the application of the surface forcing. It may also calculate the implied +!! turbulent kinetic energy requirements for this forcing to be mixed over the model's finite +!! vertical resolution in the surface layers. end module MOM_diabatic_aux diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ddafbc3274..44eed12295 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -67,7 +67,7 @@ module MOM_diabatic_driver use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units -use MOM_wave_speed, only : wave_speeds +use MOM_wave_speed, only : wave_speeds, wave_speed_CS, wave_speed_init use MOM_wave_interface, only : wave_parameters_CS use MOM_stochastics, only : stochastic_CS @@ -122,7 +122,7 @@ module MOM_diabatic_driver !! other diffusivities. Otherwise, the larger of kappa- !! shear and ePBL diffusivities are used. real :: ePBL_Prandtl !< The Prandtl number used by ePBL to convert vertical - !! diffusivities into viscosities. + !! diffusivities into viscosities [nondim]. integer :: nMode = 1 !< Number of baroclinic modes to consider real :: uniform_test_cg !< Uniform group velocity of internal tide !! for testing internal tides [L T-1 ~> m s-1] @@ -133,7 +133,7 @@ module MOM_diabatic_driver !! FW fluxes are applied separately or combined before !! being applied. real :: ML_mix_first !< The nondimensional fraction of the mixed layer - !! algorithm that is applied before diffusive mixing. + !! algorithm that is applied before diffusive mixing [nondim]. !! The default is 0, while 0.5 gives Strang splitting !! and 1 is a sensible value too. Note that if there !! are convective instabilities in the initial state, @@ -174,8 +174,8 @@ module MOM_diabatic_driver real :: MLD_EN_VALS(3) !< Energy values for energy mixed layer diagnostics [R Z L2 T-2 ~> J m-2] !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diag handle for mode-1 speed - integer, allocatable, dimension(:) :: id_cn ! diag handle for all mode speeds + integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed + integer, allocatable, dimension(:) :: id_cn ! diagnostic handle for all mode speeds integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 @@ -231,14 +231,15 @@ module MOM_diabatic_driver type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct - type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control struct - type(energetic_PBL_CS) :: ePBL !< Energetic PBL control struct - type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct - type(geothermal_CS) :: geothermal !< Geothermal control struct - type(int_tide_CS) :: int_tide !< Internal tide control struct - type(opacity_CS) :: opacity !< Opacity control struct - type(regularize_layers_CS) :: regularize_layers !< Regularize layer control struct + type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control structure + type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control structure + type(energetic_PBL_CS) :: ePBL !< Energetic PBL control structure + type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control structure + type(geothermal_CS) :: geothermal !< Geothermal control structure + type(int_tide_CS) :: int_tide !< Internal tide control structure + type(opacity_CS) :: opacity !< Opacity control structure + type(regularize_layers_CS) :: regularize_layers !< Regularize layer control structure + type(wave_speed_CS) :: wave_speed !< Wave speed control struct type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass @@ -395,7 +396,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%uniform_test_cg > 0.0) then do m=1,CS%nMode ; cn_IGW(:,:,m) = CS%uniform_test_cg ; enddo else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, full_halos=.true.) + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, CS%wave_speed, full_halos=.true.) endif call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & @@ -1659,9 +1660,10 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & ! These are targets so that the space can be shared with eaml & ebml. - eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and - ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) + eatr, & ! The equivalent of ea for tracers, which differs from ea in that it tends to + ! homogenize tracers in massless layers near the boundaries [H ~> m or kg m-2] + ebtr ! The equivalent of eb for tracers, which differs from eb in that it tends to + ! homogenize tracers in massless layers near the boundaries [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] @@ -1781,6 +1783,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & eaml, ebml, G, GV, US, CS%bulkmixedlayer, CS%optics, & Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & G, GV, US, CS%bulkmixedlayer, CS%optics, & @@ -2620,7 +2623,7 @@ subroutine adiabatic(h, tv, fluxes, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: zeros ! An array of zeros. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: zeros ! An array of zeros with units of [H ~> m or kg m-2] zeros(:,:,:) = 0.0 @@ -2646,8 +2649,8 @@ subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, type(diabatic_CS), pointer :: CS !< module control structure ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d ! A 3-d work array for diagnostics [various] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array for diagnostics [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: ppt2mks ! Conversion factor from S to kg/kg [S-1 ~> ppt-1]. integer :: i, j, k, is, ie, js, je, nz @@ -2741,8 +2744,8 @@ subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, type(diabatic_CS), pointer :: CS !< module control structure ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d ! A 3-d work array for diagnostics [various] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array for diagnostics [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] real :: ppt2mks ! Conversion factor from S to kg/kg [S-1 ~> ppt-1]. integer :: i, j, k, is, ie, js, je, nz @@ -2828,8 +2831,8 @@ subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, US, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d - real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_3d ! A 3-d work array for diagnostics [various] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array for diagnostics [various] real :: Idt ! The inverse of the timestep [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz @@ -2942,10 +2945,13 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di !! tracer flow control module type(sponge_CS), pointer :: sponge_CSp !< pointer to the sponge module control structure 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 + type(oda_incupd_CS), pointer :: oda_incupd_CSp !< pointer to the ocean data assimilation incremental + !! update module control structure ! Local variables - real :: Kd ! A diffusivity used in the default for other tracer diffusivities, in MKS units [m2 s-1] + real :: Kd ! A diffusivity used in the default for other tracer diffusivities [Z2 T-1 ~> m2 s-1] + real :: IGW_c1_thresh ! A threshold first mode internal wave speed below which all higher + ! mode speeds are not calculated but simply assigned a speed of 0 [L T-1 ~> m s-1]. logical :: use_temperature character(len=20) :: EN1, EN2, EN3 @@ -3043,6 +3049,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes "//& "that will be calculated.", default=1, do_not_log=.true.) + call get_param(param_file, mdl, "INTERNAL_WAVE_CG1_THRESH", IGW_c1_thresh, & + "A minimal value of the first mode internal wave speed below which all higher "//& + "mode speeds are not calculated but are simply reported as 0. This must be "//& + "non-negative for the wave_speeds routine to be used.", & + units="m s-1", default=0.01, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & "If positive, a uniform group velocity of internal tide for test case", & default=-1., units="m s-1", scale=US%m_s_to_L_T) @@ -3082,11 +3093,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "KD_MIN_TR were operating.", default=.false., do_not_log=.not.CS%useALEalgorithm) if (CS%mix_boundary_tracers .or. CS%mix_boundary_tracer_ALE) then - call get_param(param_file, mdl, "KD", Kd, default=0.0) + call get_param(param_file, mdl, "KD", Kd, units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to "//& "tracers, especially in massless layers near the bottom. "//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m2_s_to_Z2_T) + "The default is 0.1*KD.", & + units="m2 s-1", default=0.1*Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will "//& "allow for explicitly specified bottom fluxes. The "//& @@ -3280,9 +3292,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif - ! diagnostics for tendencies of temp and saln due to diabatic processes + ! Diagnostics for tendencies of temperature and salinity due to diabatic processes, ! available only for ALE algorithm. - ! diagnostics for tendencies of temp and heat due to frazil + ! Diagnostics for tendencies of temperature and heat due to frazil CS%id_diabatic_diff_h = register_diag_field('ocean_model', 'diabatic_diff_h', diag%axesTL, Time, & 'Cell thickness used during diabatic diffusion', & thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.) @@ -3354,9 +3366,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%diabatic_diff_tendency_diag = .true. endif - ! diagnostics for tendencies of thickness temp and saln due to boundary forcing + ! Diagnostics for tendencies of thickness temperature and salinity due to boundary forcing, ! available only for ALE algorithm. - ! diagnostics for tendencies of temp and heat due to frazil + ! Diagnostics for tendencies of temperature and heat due to frazil CS%id_boundary_forcing_h = register_diag_field('ocean_model', 'boundary_forcing_h', diag%axesTL, Time, & 'Cell thickness after applying boundary forcing', & thickness_units, conversion=GV%H_to_MKS, v_extensive=.true.) @@ -3463,6 +3475,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call int_tide_input_init(Time, G, GV, US, param_file, diag, CS%int_tide_input_CSp, & CS%int_tide_input) call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) + call wave_speed_init(CS%wave_speed, c1_thresh=IGW_c1_thresh) endif physical_OBL_scheme = (CS%use_bulkmixedlayer .or. CS%use_KPP .or. CS%use_energetic_PBL) @@ -3593,8 +3606,8 @@ end subroutine diabatic_driver_end !! calculated flux of the layer above and an estimated flux in the !! layer below. This flux is subject to the following conditions: !! (1) the flux in the top and bottom layers are set by the boundary -!! conditions, and (2) no layer may be driven below an Angstrom thick- -!! ness. If there is a bulk mixed layer, the buffer layer is treated +!! conditions, and (2) no layer may be driven below a minimal thickness. +!! If there is a bulk mixed layer, the buffer layer is treated !! as a fixed density layer with vanishingly small diffusivity. !! !! diabatic takes 5 arguments: the two velocities (u and v), the diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 2ddf8b8c7a..bbc4c9bf96 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -68,9 +68,11 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) real, dimension(GV%ke+1) :: & Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. - real :: ustar, absf, htot + real :: ustar ! The local friction velocity [Z T-1 ~> m s-1] + real :: absf ! The absolute value of the Coriolis parameter [T-1 ~> s-1] + real :: htot ! The sum of the thicknesses [H ~> m or kg m-2]. real :: energy_Kd ! The energy used by diapycnal mixing [R Z L2 T-3 ~> W m-2]. - real :: tmp1 ! A temporary array. + real :: tmp1 ! A temporary array [H Z ~> m2 or kg m-1] integer :: i, j, k, is, ie, js, je, nz logical :: may_print is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -100,7 +102,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) ustar = 0.01*US%m_to_Z*US%T_to_s ! Change this to being an input parameter? absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & - (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) + (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z @@ -168,24 +170,38 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! mixing effects with other yet lower layers [C H ~> degC m or degC kg m-2]. Sh_b, & ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [S H ~> ppt m or ppt kg m-2]. - dT_to_dPE, & ! Partial derivative of column potential energy with the temperature and salinity - dS_to_dPE, & ! changes within a layer [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1] - dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. - dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. - dT_to_dColHt_b, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water column [Z C-1 ~> m degC-1] and [Z S-1 ~> m ppt-1]. - dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column, in - ! units of [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. - dT_to_dPE_b, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_b, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers lower in the water column, in - ! units of [R Z L2 T-2 C-1 ~> J m-2 degC-1] and [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. + dT_to_dPE, & ! Partial derivative of column potential energy with the temperature changes within + ! a layer [R Z L2 T-2 C-1 ~> J m-2 degC-1] + dS_to_dPE, & ! Partial derivative of column potential energy with the salinity changes within + ! a layer [R Z L2 T-2 S-1 ~> J m-2 ppt-1] + dT_to_dColHt, & ! Partial derivative of the total column height with the temperature + ! changes within a layer [Z C-1 ~> m degC-1] + dS_to_dColHt, & ! Partial derivative of the total column height with the + ! salinity changes within a layer [Z S-1 ~> m ppt-1]. + dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z C-1 ~> m degC-1]. + dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! of mixing with layers higher in the water column [Z S-1 ~> m ppt-1]. + dT_to_dColHt_b, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column [Z C-1 ~> m degC-1]. + dS_to_dColHt_b, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column [Z S-1 ~> m ppt-1]. + dT_to_dPE_a, & ! Partial derivative of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column, in units of [R Z L2 T-2 C-1 ~> J m-2 degC-1]. + dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column, in units of [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. + dT_to_dPE_b, & ! Partial derivative of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column, in units of [R Z L2 T-2 C-1 ~> J m-2 degC-1]. + dS_to_dPE_b, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers lower + ! in the water column, in units of [R Z L2 T-2 S-1 ~> J m-2 ppt-1]. hp_a, & ! An effective pivot thickness of the layer including the effects ! of coupling with layers above [H ~> m or kg m-2]. This is the first term ! in the denominator of b1 in a downward-oriented tridiagonal solver. @@ -243,16 +259,26 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! The following are a bunch of diagnostic arrays for debugging purposes. real, dimension(GV%ke) :: & - Ta, Sa, Tb, Sb + Ta, Tb, & ! Copies of temperature profiles for debugging [C ~> degC] + Sa, Sb ! Copies of salinity profiles for debugging [S ~> ppt] real, dimension(GV%ke+1) :: & - dPEa_dKd, dPEa_dKd_est, dPEa_dKd_err, dPEa_dKd_trunc, dPEa_dKd_err_norm, & - dPEb_dKd, dPEb_dKd_est, dPEb_dKd_err, dPEb_dKd_trunc, dPEb_dKd_err_norm - real :: PE_chg_tot1A, PE_chg_tot2A, T_chg_totA - real :: PE_chg_tot1B, PE_chg_tot2B, T_chg_totB - real :: PE_chg_tot1C, PE_chg_tot2C, T_chg_totC - real :: PE_chg_tot1D, PE_chg_tot2D, T_chg_totD - real, dimension(GV%ke+1) :: dPEchg_dKd - real :: PE_chg(6) + dPEa_dKd, dPEa_dKd_est, & ! Estimates of the partial derivative of the column potential energy + ! change with Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + dPEb_dKd, dPEb_dKd_est, & ! Estimates of the partial derivative of the column potential energy + ! change with Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + dPEa_dKd_err, dPEb_dKd_err, & ! Differences in estimates of the partial derivative of the column + ! potential energy change with Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + dPEa_dKd_err_norm, dPEb_dKd_err_norm, & ! Normalized changes in sensitivities [nondim] + dPEa_dKd_trunc, dPEb_dKd_trunc ! Estimates of the truncation error in estimates of the partial + ! derivative of the column potential energy change with + ! Kddt_h [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. + real :: PE_chg_tot1A, PE_chg_tot2A ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: PE_chg_tot1B, PE_chg_tot2B ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: PE_chg_tot1C, PE_chg_tot2C ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: PE_chg_tot1D, PE_chg_tot2D ! Changes in column potential energy [R Z L2 T-2 ~> J m-2] + real :: T_chg_totA, T_chg_totB ! Vertically integrated temperature changes [C H ~> degC m or degC kg m-2] + real :: T_chg_totC, T_chg_totD ! Vertically integrated temperature changes [C H ~> degC m or degC kg m-2] + real :: PE_chg(6) ! The potential energy change within the first few iterations [R Z L2 T-2 ~> J m-2] integer :: k, nz, itt, k_cent logical :: surface_BL, bottom_BL, central, halves, debug @@ -309,7 +335,6 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & ! PE_chg_k(1) = 0.0 ; PE_chg_k(nz+1) = 0.0 ! PEchg(:) = 0.0 PE_chg_k(:,:) = 0.0 ; ColHt_cor_k(:,:) = 0.0 - dPEchg_dKd(:) = 0.0 if (surface_BL) then ! This version is appropriate for a surface boundary layer. old_PE_calc = .false. @@ -1031,7 +1056,7 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h, !! [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could - !! be realizedd by applying a huge value of Kddt_h at the + !! be realized by applying a huge value of Kddt_h at the !! present interface [R Z L2 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the !! limit where Kddt_h = 0 [R Z L2 T-2 H-1 ~> J m-3 or J kg-1]. diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 862f775225..641816513c 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -59,7 +59,7 @@ module MOM_energetic_PBL !! returned value from the previous guess or bisection before this. integer :: max_MLD_its !< The maximum number of iterations that can be used to find a !! self-consistent mixed layer depth with Use_MLD_iteration. - real :: MixLenExponent !< Exponent in the mixing length shape-function. + real :: MixLenExponent !< Exponent in the mixing length shape-function [nondim]. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by @@ -68,11 +68,11 @@ module MOM_energetic_PBL real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the - !! diffusive length scale by rotation. Making this larger decreases + !! diffusive length scale by rotation [nondim]. Making this larger decreases !! the diffusivity in the planetary boundary layer. real :: transLay_scale !< A scale for the mixing length in the transition layer !! at the edge of the boundary layer as a fraction of the - !! boundary layer thickness. The default is 0, but a + !! boundary layer thickness [nondim]. The default is 0, but a !! value of 0.1 might be better justified by observations. real :: MLD_tol !< A tolerance for determining the boundary layer thickness when !! Use_MLD_iteration is true [H ~> m or kg m-2]. @@ -98,7 +98,7 @@ module MOM_energetic_PBL integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing, - !! there must be a cap on how large it can be. This + !! there must be a cap on how large it can be [nondim]. This !! is definitely a function of latitude (Ekman limit), !! but will be taken as constant for now. @@ -113,45 +113,45 @@ module MOM_energetic_PBL !! for using a fixed mstar is used. !/ mstar_scheme == 2 - real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 - real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 [nondim] + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 [nondim] !/ mstar_scheme == 3 - real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outer-most coefficient for fit). + real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outer-most coefficient for fit) [nondim]. !! Value of 0.275 in RH18. Increasing this !! coefficient increases mechanical mixing for all values of Hf/ust, !! but is most effective at low values (weakly developed OSBLs). - real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). + real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay) [nondim]. !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR !! for all values of HF/ust, with a consistent affect across !! a wide range of Hf/ust. - real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of + real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient) [nondim]. Value of !! -5.0 in RH18. Increasing this increases how quickly the value !! of MSTAR decreases as Hf/ust increases. - real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. + real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit [nondim]. !! Value of 0.2 in RH18. - real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. + real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit [nondim]. !! Value of 0.4 in RH18. !/ Coefficient for shear/convective turbulence interaction - real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable. + real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable [nondim]. !/ Langmuir turbulence related parameters logical :: Use_LT = .false. !< Flag for using LT in Energy calculation integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) - real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancement - real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement + real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancement [nondim] + real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement [nondim] real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of - !! the mixed layer depth over the Ekman depth. + !! the mixed layer depth over the Ekman depth [nondim]. real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of - !! the mixed layer depth over the Obukhov depth with stabilizing forcing. + !! the mixed layer depth over the Obukhov depth with stabilizing forcing [nondim]. real :: LaC_EKoOB_stab !< Coefficient for Langmuir number modification based on the ratio of - !! the Ekman depth over the Obukhov depth with stabilizing forcing. + !! the Ekman depth over the Obukhov depth with stabilizing forcing [nondim]. real :: LaC_MLDoOB_un !< Coefficient for Langmuir number modification based on the ratio of - !! the mixed layer depth over the Obukhov depth with destabilizing forcing. + !! the mixed layer depth over the Obukhov depth with destabilizing forcing [nondim]. real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of - !! the Ekman depth over the Obukhov depth with destabilizing forcing. - real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing. + !! the Ekman depth over the Obukhov depth with destabilizing forcing [nondim]. + real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing [nondim]. !/ Others type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. @@ -229,8 +229,8 @@ module MOM_energetic_PBL !> A type for conveniently passing around ePBL diagnostics for a column. type, public :: ePBL_column_diags ; private !>@{ Local column copies of energy change diagnostics, all in [R Z3 T-3 ~> W m-2]. - real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing - real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay + real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing ! Local column diagnostics [R Z3 T-3 ~> W m-2] + real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay ! Local column diagnostics [R Z3 T-3 ~> W m-2] !>@} real :: LA !< The value of the Langmuir number [nondim] real :: LAmod !< The modified Langmuir number by convection [nondim] @@ -570,8 +570,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! during this timestep [R Z3 T-2 ~> J m-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. - real :: uhtot ! The depth integrated zonal and meridional velocities in the - real :: vhtot ! layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + real :: uhtot ! The depth integrated zonal velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1] + real :: vhtot ! The depth integrated meridional velocities in the layers above [H L T-1 ~> m2 s-1 or kg m-1 s-1] real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. @@ -612,7 +612,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate asymptotic value at the bottom of - ! the boundary layer. + ! the boundary layer [nondim]. Kddt_h ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. @@ -642,9 +642,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! a surface mixing roughness length given by h_tt_min [H ~> m or kg m-2]. real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. - real :: C1_3 ! = 1/3. + real :: C1_3 ! = 1/3 [nondim] real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m3 Z-3 R-1 T2 s-3 ~> m3 kg-1 s-1]. - ! This is used convert TKE back into ustar^3. + ! This is used convert TKE back into ustar^3 for use in a cube root. real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1]. real :: mstar_total ! The value of mstar used in ePBL [nondim] real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) @@ -708,8 +708,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs ! - needed to compute new mixing length. real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [H ~> m or kg m-2]. real :: MLD_guess_Z ! A guessed mixed layer depth, converted to height units [Z ~> m] - real :: min_MLD ! Iteration bounds [H ~> m or kg m-2], which are adjusted at each step - real :: max_MLD ! - These are initialized based on surface/bottom + real :: min_MLD, max_MLD ! Iteration bounds on MLD [H ~> m or kg m-2], which are adjusted at each step + ! - These are initialized based on surface/bottom ! 1. The iteration guesses a value (possibly from prev step or neighbor). ! 2. The iteration checks if value is converged, too shallow, or too deep. ! 3. Based on result adjusts the Max/Min and searches through the water column. @@ -726,14 +726,24 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs logical :: OBL_converged ! Flag for convergence of MLD integer :: OBL_it ! Iteration counter - real :: Surface_Scale ! Surface decay scale for vstar + real :: Surface_Scale ! Surface decay scale for vstar [nondim] logical :: calc_Te ! If true calculate the expected final temperature and salinity values. logical :: debug ! This is used as a hard-coded value for debugging. ! The following arrays are used only for debugging purposes. - real :: dPE_debug, mixing_debug - real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt - real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k + real :: dPE_debug ! An estimate of the potential energy change [R Z3 T-2 ~> J m-2] + real :: mixing_debug ! An estimate of the rate of change of potential energy due to mixing [R Z3 T-3 ~> W m-2] + real, dimension(20) :: TKE_left_itt ! The value of TKE_left after each iteration [R Z3 T-2 ~> J m-2] + real, dimension(20) :: PE_chg_itt ! The value of PE_chg after each iteration [R Z3 T-2 ~> J m-2] + real, dimension(20) :: Kddt_h_itt ! The value of Kddt_h_guess after each iteration [H ~> m or kg m-2] + real, dimension(20) :: dPEa_dKd_itt ! The value of dPEc_dKd after each iteration [R Z3 T-2 H-1 ~> J m-3 or J kg-1] + real, dimension(20) :: MKE_src_itt ! The value of MKE_src after each iteration [R Z3 T-2 ~> J m-2] + real, dimension(SZK_(GV)) :: mech_TKE_k ! The mechanically generated turbulent kinetic energy + ! available for mixing over a time step for each layer [R Z3 T-2 ~> J m-2]. + real, dimension(SZK_(GV)) :: conv_PErel_k ! The potential energy that has been convectively released + ! during this timestep for each layer [R Z3 T-2 ~> J m-2]. + real, dimension(SZK_(GV)) :: nstar_k ! The fraction of conv_PErel that can be converted to mixing + ! for each layer [nondim]. real, dimension(SZK_(GV)) :: dT_expect !< Expected temperature changes [C ~> degC] real, dimension(SZK_(GV)) :: dS_expect !< Expected salinity changes [S ~> ppt] integer, dimension(SZK_(GV)) :: num_itts @@ -1185,7 +1195,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs Kddt_h(K) = Kd(K) * dt_h elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then - ! This column is convctively stable and there is energy to support the suggested + ! This column is convectively stable and there is energy to support the suggested ! mixing. Keep that estimate. Kd(K) = Kd_guess0 Kddt_h(K) = Kddt_h_g0 @@ -1398,7 +1408,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs MLD_guess = 0.5*(min_MLD + max_MLD) else ! Try using the false position method or the returned value instead of simple bisection. ! Taking the occasional step with MLD_output empirically helps to converge faster. - if ((dMLD_min > 0.0) .and. (dMLD_max < 0.0) .and. (OBL_it > 2) .and. (mod(OBL_it-1,4)>0)) then + if ((dMLD_min > 0.0) .and. (dMLD_max < 0.0) .and. (OBL_it > 2) .and. (mod(OBL_it-1,4) > 0)) then ! Both bounds have valid change estimates and are probably in the range of possible outputs. MLD_Guess = (dMLD_min*max_MLD - dMLD_max*min_MLD) / (dMLD_min - dMLD_max) elseif ((MLD_found > min_MLD) .and. (MLD_found < max_MLD)) then @@ -1809,7 +1819,6 @@ subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& MStar = MStar * MStar_Conv_Red if (present(Langmuir_Number)) then - !### In this call, ustar was previously ustar_mean. Is this change deliberate, Brandon? -RWH call mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langmuir_Number, MStar, & MStar_LT, Convect_Langmuir_Number) endif @@ -1831,9 +1840,9 @@ subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langm real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] !/ - real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. - real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence. - real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence. + real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio [nondim]. + real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence [nondim]. + real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence [nondim]. real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1] @@ -1841,10 +1850,14 @@ subroutine Mstar_Langmuir(CS, US, Abs_Coriolis, Buoyancy_Flux, UStar, BLD, Langm real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim]. - real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim]. - real :: Ekman_Obukhov_stab ! > - real :: MLD_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_Obukhov_un ! > + real :: MLD_Obukhov_stab ! The mixed layer depth divided by the Obukhov depth under stable + ! conditions or 0 under unstable conditions [nondim]. + real :: Ekman_Obukhov_stab ! The Ekman layer thickness divided by the Obukhov depth under stable + ! conditions or 0 under unstable conditions [nondim]. + real :: MLD_Obukhov_un ! The mixed layer depth divided by the Obukhov depth under unstable + ! conditions or 0 under stable conditions [nondim]. + real :: Ekman_Obukhov_un ! The Ekman layer thickness divided by the Obukhov depth under unstable + ! conditions or 0 under stable conditions [nondim]. ! Set default values for no Langmuir effects. enhance_mstar = 1.0 ; mstar_LT_add = 0.0 @@ -1910,9 +1923,9 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [Z ~> m] or other units real, optional, intent(in) :: m_to_MLD_units !< A conversion factor from meters - !! to the desired units for MLD + !! to the desired units for MLD, sometimes [m Z-1 ~> 1] ! Local variables - real :: scale ! A dimensional rescaling factor + real :: scale ! A dimensional rescaling factor, often [nondim] or [m Z-1 ~> 1] integer :: i,j scale = 1.0 ; if (present(m_to_MLD_units)) scale = US%Z_to_m * m_to_MLD_units @@ -1939,7 +1952,7 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) # include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. character(len=20) :: tmpstr - real :: omega_frac_dflt + real :: omega_frac_dflt ! The default for omega_frac [nondim] integer :: isd, ied, jsd, jed integer :: mstar_mode, LT_enhance, wT_mode integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. @@ -1961,8 +1974,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/1. General ePBL settings call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_S) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_S) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -2014,8 +2027,8 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & "The efficiency with which mean kinetic energy released "//& "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy.", units="nondim", & - default=0.0) + "is converted to turbulent kinetic energy.", & + units="nondim", default=0.0) call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "TKE_DECAY relates the vertical rate of decay of the "//& "TKE available for mechanical entrainment to the natural "//& @@ -2222,14 +2235,13 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Options related to Langmuir turbulence call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& - "determine the Langmuir number.", units="nondim", default=.false.) + "determine the Langmuir number.", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. if (use_LA_windsea) then CS%use_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%use_LT, & - "A logical to use a LT parameterization.", & - units="nondim", default=.false.) + "A logical to use a LT parameterization.", default=.false.) endif if (CS%use_LT) then call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & @@ -2309,9 +2321,10 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) !/ Logging parameters ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & + call log_param(param_file, mdl, "!EPBL_USTAR_MIN", CS%ustar_min, & "The (tiny) minimum friction velocity used within the "//& - "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1", & + "ePBL code, derived from OMEGA and ANGSTROM.", & + units="m s-1", unscale=US%Z_to_m*US%s_to_T, & like_default=.true.) @@ -2391,7 +2404,7 @@ subroutine energetic_PBL_end(CS) type(energetic_PBL_CS), intent(inout) :: CS !< Energetic_PBL control structure character(len=256) :: mesg - real :: avg_its + real :: avg_its ! The averaged number of iterations used by ePBL [nondim] if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) if (allocated(CS%LA)) deallocate(CS%LA) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index beb207624a..51a28db0e9 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -34,6 +34,9 @@ module MOM_entrain_diffusive !! calculate the diapycnal entrainment. real :: Tolerance_Ent !< The tolerance with which to solve for entrainment values !! [H ~> m or kg m-2]. + real :: max_Ent !< A large ceiling on the maximum permitted amount of entrainment + !! across each interface between the mixed and buffer layers within + !! a timestep [H ~> m or kg m-2]. real :: Rho_sig_off !< The offset between potential density and a sigma value [R ~> kg m-3] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -113,7 +116,8 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & diff_work ! The work actually done by diffusion across each ! interface [R Z3 T-3 ~> W m-2]. Sum vertically for the total work. - real :: hm, fm, fr, fk ! Work variables with units of H, H, H, and H2. + real :: hm, fm, fr ! Work variables with units of [H ~> m or kg m-2]. + real :: fk ! A Work variable with units of [H2 ~> m2 or kg2 m-4] real :: b1(SZI_(G)) ! A variable used by the tridiagonal solver [H ~> m or kg m-2] real :: c1(SZI_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim] @@ -140,9 +144,11 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & zeros, & ! An array of all zeros. (Usually used with [H ~> m or kg m-2].) max_eakb, & ! The maximum value of eakb that might be realized [H ~> m or kg m-2]. min_eakb, & ! The minimum value of eakb that might be realized [H ~> m or kg m-2]. - err_max_eakb0, & ! The value of error returned by determine_Ea_kb - err_min_eakb0, & ! when eakb = min_eakb and max_eakb and ea_kbp1 = 0. - err_eakb0, & ! A value of error returned by determine_Ea_kb. + err_max_eakb0, & ! The value of error returned by determine_Ea_kb when eakb = max_eakb + ! and ea_kbp1 = 0 [H2 ~> m2 or kg2 m-4]. + err_min_eakb0, & ! The value of error returned by determine_Ea_kb when eakb = min_eakb + ! and ea_kbp1 = 0 [H2 ~> m2 or kg2 m-4]. + err_eakb0, & ! A value of error returned by determine_Ea_kb [H2 ~> m2 or kg2 m-4]. F_kb, & ! The value of F in layer kb, or equivalently the entrainment ! from below by layer kb [H ~> m or kg m-2]. dFdfm_kb, & ! The partial derivative of F with fm [nondim]. See dFdfm. @@ -187,7 +193,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! entrain from the layer above [H ~> m or kg m-2]. real :: Kd_here ! The effective diapycnal diffusivity times the timestep [H2 ~> m2 or kg2 m-4]. real :: h_avail ! The thickness that is available for entrainment [H ~> m or kg m-2]. - real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account. + real :: dS_kb_eff ! The value of dS_kb after limiting is taken into account [R ~> kg m-3]. real :: Rho_cor ! The depth-integrated potential density anomaly that ! needs to be corrected for [H R ~> kg m-2 or kg2 m-5]. real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. @@ -752,7 +758,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ea(i,j,k) = ea(i,j,k) + ea_cor eb(i,j,k) = eb(i,j,k) - (dS_kb(i) * I_dSkbp1(i)) * ea_cor elseif (k < kb(i)) then - ! Repetative, unless ea(kb) has been corrected. + ! Repetitive, unless ea(kb) has been corrected. ea(i,j,k) = ea(i,j,k+1) endif enddo @@ -761,7 +767,7 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ea(i,j,k) = ea(i,j,k+1) enddo ; enddo - ! Repetative, unless ea(kb) has been corrected. + ! Repetitive, unless ea(kb) has been corrected. k=kmb do i=is,ie ! Do not adjust eb through the base of the buffer layers, but it @@ -909,7 +915,7 @@ subroutine F_to_ent(F, h, kb, kmb, j, G, GV, CS, dsp1_ds, eakb, Ent_bl, ea, eb) real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dsp1_ds !< The ratio of coordinate variable !! differences across the interfaces below !! a layer over the difference across the - !! interface above the layer. + !! interface above the layer [nondim]. real, dimension(SZI_(G)), intent(in) :: eakb !< The entrainment from above by the layer !! below the buffer layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: Ent_bl !< The average entrainment upward and @@ -1050,7 +1056,6 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, real, dimension(SZI_(G), SZK_(GV)) :: & S_est ! An estimate of the coordinate potential density - 1000 after ! entrainment for each layer [R ~> kg m-3]. - real :: max_ent ! The maximum possible entrainment [H ~> m or kg m-2]. real :: dh ! An available thickness [H ~> m or kg m-2]. real :: Kd_x_dt ! The diffusion that remains after thin layers are ! entrained [H2 ~> m2 or kg2 m-4]. @@ -1060,8 +1065,6 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = GV%ke -! max_ent = 1.0e14*GV%Angstrom_H ! This is set to avoid roundoff problems. - max_ent = 1.0e4*GV%m_to_H h_neglect = GV%H_subroundoff do i=is,ie ; pres(i) = tv%P_Ref ; enddo @@ -1081,8 +1084,7 @@ subroutine set_Ent_bl(h, dtKd_int, tv, kb, kmb, do_i, G, GV, US, CS, j, Ent_bl, do k=2,kmb ; do i=is,ie if (do_i(i)) then - Ent_bl(i,K) = min(2.0 * dtKd_int(i,K) / (h(i,j,k-1) + h(i,j,k) + h_neglect), & - max_ent) + Ent_bl(i,K) = min(2.0 * dtKd_int(i,K) / (h(i,j,k-1) + h(i,j,k) + h_neglect), CS%max_Ent) else ; Ent_bl(i,K) = 0.0 ; endif enddo ; enddo @@ -1232,13 +1234,14 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - b1, c1, & ! b1 and c1 are variables used by the tridiagonal solver. - S, dS_dE, & ! The coordinate density [R ~> kg m-3] and its derivative with E. - ea, dea_dE, & ! The entrainment from above and its derivative with E. - eb, deb_dE ! The entrainment from below and its derivative with E. - real :: deriv_dSkb(SZI_(G)) - real :: d1(SZI_(G)) ! d1 = 1.0-c1 is also used by the tridiagonal solver. - real :: src ! A source term for dS_dR. + b1, c1, & ! b1 [H-1 ~> m-1 or m2 kg-1] and c1 [nondim] are variables used by the tridiagonal solver. + S, dS_dE, & ! The coordinate density [R ~> kg m-3] and its derivative with E [R H-1 ~> kg m-4 or m-1]. + ea, dea_dE, & ! The entrainment from above [H ~> m or kg m-2] and its derivative with E [nondim]. + eb, deb_dE ! The entrainment from below [H ~> m or kg m-2] and its derivative with E [nondim]. + real :: deriv_dSkb(SZI_(G)) ! The limited derivative of the new density difference across the base of + ! the buffer layers with the new density of the bottommost buffer layer [nondim] + real :: d1(SZI_(G)) ! d1 = 1.0-c1 is also used by the tridiagonal solver [nondim]. + real :: src ! A source term for dS_dR [R ~> kg m-3]. real :: h1 ! The thickness in excess of the minimum that will remain ! after exchange with the layer below [H ~> m or kg m-2]. logical, dimension(SZI_(G)) :: do_i @@ -1247,13 +1250,15 @@ subroutine determine_dSkb(h_bl, Sref, Ent_bl, E_kb, is, ie, kmb, G, GV, limit, & real :: h_tr ! h_tr is h at tracer points with a tiny thickness ! added to ensure positive definiteness [H ~> m or kg m-2]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. - real :: rat - real :: dS_kbp1, IdS_kbp1 - real :: deriv_dSLay - real :: Inv_term ! [nondim] + real :: rat ! A ratio of density differences [nondim] + real :: dS_kbp1 ! The density difference between the top two interior layers [R ~> kg m-3]. + real :: IdS_kbp1 ! The inverse of dS_kbp1 [R-1 ~> m3 kg-1] + real :: deriv_dSLay ! The derivative of the projected density difference across the topmost interior + ! layer with the density difference across the interface above it [nondim] + real :: Inv_term ! The inverse of a nondimensional expression [nondim] real :: f1, df1_drat ! Temporary variables [nondim]. real :: z, dz_drat, f2, df2_dz, expz ! Temporary variables [nondim]. - real :: eps_dSLay, eps_dSkb ! Small nondimensional constants. + real :: eps_dSLay, eps_dSkb ! Small nondimensional constants [nondim]. integer :: i, k if (present(ddSlay_dE) .and. .not.present(dSlay)) call MOM_error(FATAL, & @@ -1447,16 +1452,21 @@ subroutine F_kb_to_ea_kb(h_bl, Sref, Ent_bl, I_dSkbp1, F_kb, kmb, i, & real, optional, intent(in) :: tol_in !< A tolerance for the iterative determination !! of the entrainment [H ~> m or kg m-2]. - real :: max_ea, min_ea - real :: err, err_min, err_max - real :: derr_dea - real :: val, tolerance, tol1 - real :: ea_prev - real :: dS_kbp1 - logical :: bisect_next, Newton - real, dimension(SZI_(G)) :: dS_kb - real, dimension(SZI_(G)) :: maxF, ent_maxF, zeros - real, dimension(SZI_(G)) :: ddSkb_dE + real :: max_ea, min_ea ! Bounds on the estimated entraiment [H ~> m or kg m-2] + real :: err, err_min, err_max ! Errors in the mass flux balance [H R ~> kg m-2 or kg2 m-5] + real :: derr_dea ! The change in error with the change in ea [R ~> kg m-3] + real :: val ! An estimate mass flux [H R ~> kg m-2 or kg2 m-5] + real :: tolerance, tol1 ! Tolerances for the determination of the entrainment [H ~> m or kg m-2] + real :: ea_prev ! A previous estimate of ea_kb [H ~> m or kg m-2] + real :: dS_kbp1 ! The density difference between two interior layers [R ~> kg m-3] + real :: dS_kb(SZI_(G)) ! The limited potential density difference across the interface + ! between the bottommost buffer layer and the topmost interior layer [R ~> kg m-3] + real :: maxF(SZI_(G)) ! The maximum value of F (the density flux divided by density + ! differences) found in the range min_ent < ent < max_ent [H ~> m or kg m-2]. + real :: ent_maxF(SZI_(G)) ! The value of entrainment that gives maxF [H ~> m or kg m-2] + real :: zeros(SZI_(G)) ! An array of zero entrainments [H ~> m or kg m-2] + real :: ddSkb_dE(SZI_(G)) ! The partial derivative of dS_kb with ea_kb [R H-1 ~> kg m-4 or m-1] + logical :: bisect_next, Newton ! These indicate what method the next iteration should use integer :: it integer, parameter :: MAXIT = 30 @@ -1589,13 +1599,15 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & !! The input value is the first guess. real, dimension(SZI_(G)), optional, intent(out) :: error !< The error (locally defined in this !! routine) associated with the returned - !! solution. + !! solution [H2 ~> m2 or kg2 m-4] real, dimension(SZI_(G)), optional, intent(in) :: err_min_eakb0 !< The errors (locally defined) !! associated with min_eakb when ea_kbp1 = 0, - !! returned from a previous call to this fn. + !! returned from a previous call to this + !! subroutine [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G)), optional, intent(in) :: err_max_eakb0 !< The errors (locally defined) !! associated with min_eakb when ea_kbp1 = 0, - !! returned from a previous call to this fn. + !! returned from a previous call to this + !! subroutine [H2 ~> m2 or kg2 m-4]. real, dimension(SZI_(G)), optional, intent(out) :: F_kb !< The entrainment from below by the !! uppermost interior layer !! corresponding to the returned @@ -1719,7 +1731,7 @@ subroutine determine_Ea_kb(h_bl, dtKd_kb, Sref, I_dSkbp1, Ent_bl, ea_kbp1, & Ent(i) = Ent(i) - err(i) / derror_dE(i) elseif (false_position(i) .and. & (error_maxE(i) - error_minE(i) < 0.9*large_err)) then - ! Use the false postion method if there are decent error estimates. + ! Use the false position method if there are decent error estimates. Ent(i) = E_min(i) + (E_max(i)-E_min(i)) * & (-error_minE(i)/(error_maxE(i) - error_minE(i))) false_position(i) = .false. @@ -1802,9 +1814,9 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & !! limited value at ent=max_ent_in in this !! array [H ~> m or kg m-2]. real, dimension(SZI_(G)), & - optional, intent(in) :: F_thresh !< If F_thresh is present, return the first - !! value found that has F > F_thresh, or - !! the maximum. + optional, intent(in) :: F_thresh !< If F_thresh is present, return the first value + !! found that has F > F_thresh [H ~> m or kg m-2], or + !! the maximum root if it is absent. ! Maximize F = ent*ds_kb*I_dSkbp1 in the range min_ent < ent < max_ent. ! ds_kb may itself be limited to positive values in determine_dSkb, which gives @@ -1813,17 +1825,21 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & ! negative) value. It is faster to find the true maximum by first finding the ! unlimited maximum and comparing it to the limited value at max_ent_in. real, dimension(SZI_(G)) :: & - ent, & - minent, maxent, ent_best, & - F_max_ent_in, & - F_maxent, F_minent, F, F_best, & - dF_dent, dF_dE_max, dF_dE_min, dF_dE_best, & - dS_kb, dS_kb_lim, ddSkb_dE, dS_anom_lim, & - chg_prev, chg_pre_prev - real :: dF_dE_mean, maxslope, minslope - real :: tolerance - real :: ratio_select_end - real :: rat, max_chg, min_chg, chg1, chg2, chg + ent, & ! The updated estimate of the entrainment [H ~> m or kg m-2] + minent, maxent, ent_best, & ! Various previous estimates of the entrainment [H ~> m or kg m-2] + F_max_ent_in, & ! The value of F that gives the input maximum value of ent [H ~> m or kg m-2] + F_maxent, F_minent, F, F_best, & ! Various estimates of F [H ~> m or kg m-2] + dF_dent, dF_dE_max, dF_dE_min, dF_dE_best, & ! Various derivatives of F with ent [nondim] + dS_kb, & ! The density difference across the interface between the bottommost + ! buffer layer and the topmost interior layer [R ~> kg m-3] + dS_kb_lim, dS_anom_lim, & ! Various limits on dS_kb [R ~> kg m-3] + ddSkb_dE, & ! The partial derivative of dS_kb with ent [R H-1 ~> kg m-4 or m-1]. + chg_prev, chg_pre_prev ! Changes in estimates of the entrainment from previous iterations [H ~> m or kg m-2] + real :: dF_dE_mean, maxslope, minslope ! Various derivatives of F with ent [nondim] + real :: tolerance ! The tolerance within which ent must be converged [H ~> m or kg m-2] + real :: ratio_select_end, rat ! Fractional changes in the value of ent to use for the next iteration + ! relative to its bounded range [nondim] + real :: max_chg, min_chg, chg1, chg2, chg ! Changes in entrainment estimates [H ~> m or kg m-2] logical, dimension(SZI_(G)) :: do_i, last_it, need_bracket, may_use_best logical :: doany, OK1, OK2, bisect, new_min_bound integer :: i, it, is1, ie1 @@ -1876,14 +1892,14 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & maxslope = MAX(dF_dE_mean, dF_dE_min(i), dF_dE_max(i)) minslope = MIN(dF_dE_mean, dF_dE_min(i), dF_dE_max(i)) if (F_minent(i) >= F_maxent(i)) then - if (dF_dE_min(i) > 0.0) then ; rat = 0.02 ! A small step should bracket the soln. + if (dF_dE_min(i) > 0.0) then ; rat = 0.02 ! A small step should bracket the solution. elseif (maxslope < ratio_select_end*minslope) then ! The maximum of F is at minent. F_best(i) = F_minent(i) ; ent_best(i) = minent(i) ; rat = 0.0 do_i(i) = .false. else ; rat = 0.382 ; endif ! Use the golden ratio else - if (dF_dE_max(i) < 0.0) then ; rat = 0.98 ! A small step should bracket the soln. + if (dF_dE_max(i) < 0.0) then ; rat = 0.98 ! A small step should bracket the solution. elseif (minslope > ratio_select_end*maxslope) then ! The maximum of F is at maxent. F_best(i) = F_maxent(i) ; ent_best(i) = maxent(i) ; rat = 1.0 @@ -1979,7 +1995,7 @@ subroutine find_maxF_kb(h_bl, Sref, Ent_bl, I_dSkbp1, min_ent_in, max_ent_in, & new_min_bound = .true. ! We have a new minimum bound. elseif ((F(i) <= F_maxent(i)) .and. (F(i) > F_minent(i))) then new_min_bound = .false. ! We have a new maximum bound. - else ! This case would bracket a minimum. Wierd. + else ! This case would bracket a minimum. Weird. ! Unless the derivative indicates that there is a maximum near the ! lower bound, try keeping the end with the larger value of F ! in a tie keep the minimum as the answer here will be compared @@ -2068,14 +2084,14 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control struct + type(entrain_diffusive_CS), intent(inout) :: CS !< Entrainment diffusion control structure logical, intent(in) :: just_read_params !< If true, this call will only read !! and log parameters without registering !! any diagnostics ! Local variables - real :: dt ! The dynamics timestep, used here in the default for TOLERANCE_ENT, in MKS units [s] - real :: Kd ! A diffusivity used in the default for TOLERANCE_ENT, in MKS units [m2 s-1] + real :: dt ! The dynamics timestep, used here in the default for TOLERANCE_ENT [T ~> s] + real :: Kd ! A diffusivity used in the default for TOLERANCE_ENT [Z2 T-1 ~> m2 s-1] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_entrain_diffusive" ! This module's name. @@ -2090,15 +2106,19 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS, just_re call get_param(param_file, mdl, "MAX_ENT_IT", CS%max_ent_it, & "The maximum number of iterations that may be used to "//& "calculate the interior diapycnal entrainment.", default=5, do_not_log=just_read_params) - ! In this module, KD is only used to set the default for TOLERANCE_ENT. [m2 s-1] - call get_param(param_file, mdl, "KD", Kd, default=0.0) + ! In this module, KD is only used to set the default for TOLERANCE_ENT. [Z2 T-1 ~> m2 s-1] + call get_param(param_file, mdl, "KD", Kd, units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "DT", dt, & - "The (baroclinic) dynamics time step.", units = "s", & - fail_if_missing=.true., do_not_log=just_read_params) + "The (baroclinic) dynamics time step.", & + units="s", scale=US%s_to_T, fail_if_missing=.true., do_not_log=just_read_params) call get_param(param_file, mdl, "TOLERANCE_ENT", CS%Tolerance_Ent, & "The tolerance with which to solve for entrainment values.", & - units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H, & + units="m", default=US%Z_to_m*MAX(100.0*GV%Angstrom_Z,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H, & do_not_log=just_read_params) + call get_param(param_file, mdl, "ENTRAIN_DIFFUSIVE_MAX_ENT", CS%max_Ent, & + "A large ceiling on the maximum permitted amount of entrainment across each "//& + "interface between the mixed and buffer layers within a timestep.", & + units="m", default=1.0e4, scale=GV%m_to_H, do_not_log=.not.CS%bulkmixedlayer) CS%Rho_sig_off = 1000.0*US%kg_m3_to_R @@ -2119,10 +2139,10 @@ end subroutine entrain_diffusive_init !! mixing and advection in isopycnal layers. The main subroutine, !! calculate_entrainment, returns the entrainment by each layer !! across the interfaces above and below it. These are calculated -!! subject to the constraints that no layers can be driven to neg- -!! ative thickness and that the each layer maintains its target -!! density, using the scheme described in Hallberg (MWR 2000). There -!! may or may not be a bulk mixed layer above the isopycnal layers. +!! subject to the constraints that no layers can be driven to negative +!! thickness and that the each layer maintains its target density, +!! using the scheme described in Hallberg (MWR 2000). There may or +!! may not be a bulk mixed layer above the isopycnal layers. !! The solution is iterated until the change in the entrainment !! between successive iterations is less than some small tolerance. !! @@ -2134,9 +2154,9 @@ end subroutine entrain_diffusive_init !! diffusion, so the fully implicit upwind differencing scheme that !! is used is entirely appropriate. The downward buoyancy flux in !! each layer is determined from an implicit calculation based on -!! the previously calculated flux of the layer above and an estim- -!! ated flux in the layer below. This flux is subject to the foll- -!! owing conditions: (1) the flux in the top and bottom layers are +!! the previously calculated flux of the layer above and an estimated +!! flux in the layer below. This flux is subject to the following +!! conditions: (1) the flux in the top and bottom layers are !! set by the boundary conditions, and (2) no layer may be driven !! below an Angstrom thickness. If there is a bulk mixed layer, the !! mixed and buffer layers are treated as Eulerian layers, whose diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index ce19609210..3769721da1 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -107,7 +107,7 @@ subroutine geothermal_entraining(h, tv, dt, ea, eb, G, GV, US, CS, halo) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & T_old, & ! Temperature of each layer before any heat is added, for diagnostics [C ~> degC] h_old, & ! Thickness of each layer before any heat is added, for diagnostics [H ~> m or kg m-2] - work_3d ! Scratch variable used to calculate changes due to geothermal + work_3d ! Scratch variable used to calculate changes due to geothermal [various] real :: Idt ! inverse of the timestep [T-1 ~> s-1] logical :: do_i(SZI_(G)) @@ -407,7 +407,7 @@ subroutine geothermal_in_place(h, tv, dt, G, GV, US, CS, halo) if (.not.associated(tv%T)) call MOM_error(FATAL, "MOM geothermal_in_place: "//& "Geothermal heating can only be applied if T & S are state variables.") -! do i=is,ie ; do j=js,je +! do j=js,je ; do i=is,ie ! resid(i,j) = tv%internal_heat(i,j) ! enddo ; enddo @@ -573,17 +573,17 @@ subroutine geothermal_init(Time, G, GV, US, param_file, diag, CS, useALEalgorith if (id > 0) call post_data(id, CS%geo_heat, diag, .true.) ! Diagnostic for tendencies due to internal heat (in 3d) - CS%id_internal_heat_heat_tendency=register_diag_field('ocean_model', & + CS%id_internal_heat_heat_tendency = register_diag_field('ocean_model', & 'internal_heat_heat_tendency', diag%axesTL, Time, & 'Heat tendency (in 3D) due to internal (geothermal) sources', & 'W m-2', conversion=US%QRZ_T_to_W_m2, v_extensive=.true.) - CS%id_internal_heat_temp_tendency=register_diag_field('ocean_model', & + CS%id_internal_heat_temp_tendency = register_diag_field('ocean_model', & 'internal_heat_temp_tendency', diag%axesTL, Time, & 'Temperature tendency (in 3D) due to internal (geothermal) sources', & 'degC s-1', conversion=US%C_to_degC*US%s_to_T, v_extensive=.true.) if (.not.useALEalgorithm) then ! Do not offer this diagnostic if heating will be in place. - CS%id_internal_heat_h_tendency=register_diag_field('ocean_model', & + CS%id_internal_heat_h_tendency = register_diag_field('ocean_model', & 'internal_heat_h_tendency', diag%axesTL, Time, & 'Thickness tendency (in 3D) due to internal (geothermal) sources', & trim(thickness_units)//' s-1', conversion=GV%H_to_MKS*US%s_to_T, v_extensive=.true.) diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index ff2180497b..7ec612f141 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -48,13 +48,12 @@ module MOM_int_tide_input character(len=200) :: inputdir !< The directory for input files. logical :: int_tide_source_test !< If true, apply an arbitrary generation site - !! for internal tide testing (BDM) + !! for internal tide testing 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) + !! for internal tide for testing [degrees_E] or [km] real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) + !! for internal tide for testing [degrees_N] or [km] 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 @@ -185,7 +184,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) !! smooth out the values in thin layers [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h2 !< Bottom topographic roughness [Z2 ~> m2]. type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy freqency at the + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy frequency at the !! ocean bottom [T-2 ~> s-2]. ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & @@ -304,7 +303,8 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_int_tide_input" ! This module's name. - character(len=200) :: filename, tideamp_file, h2_file + character(len=200) :: filename, tideamp_file, h2_file ! Input file names or paths + character(len=80) :: tideamp_var, rough_var ! Input file variable names real :: mask_itidal ! A multiplicative land mask, 0 or 1 [nondim] real :: max_frac_rough ! The fraction relating the maximum topographic roughness @@ -386,7 +386,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', itide%tideamp, G%domain, scale=US%m_s_to_L_T) + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") + call MOM_read_data(filename, tideamp_var, itide%tideamp, G%domain, scale=US%m_s_to_L_T) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -395,7 +398,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) 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', itide%h2, G%domain, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & + "The name in the input file of the squared sub-grid-scale "//& + "topographic roughness amplitude variable.", default="h2") + call MOM_read_data(filename, rough_var, itide%h2, G%domain, scale=US%m_to_Z**2) call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& @@ -408,13 +414,13 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) 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.) + "Use global IJ for internal 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., & - do_not_log=CS%int_tide_use_glob_ij) + "X Location of generation site for internal tide", & + units=G%x_ax_unit_short, default=1.0, 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., & - do_not_log=CS%int_tide_use_glob_ij) + "Y Location of generation site for internal tide", & + units=G%y_ax_unit_short, default=1.0, 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) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 118ec9a1a1..78ec0d9391 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -54,6 +54,10 @@ module MOM_kappa_shear !! equation, 0 to eliminate the shear scale [nondim]. real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: kappa_0 !< The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: kappa_seed !< A moderately large seed value of diapycnal diffusivity that + !! is used as a starting turbulent diffusivity in the iterations + !! to findind an energetically constrained solution for the + !! shear-driven diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_trunc !< Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated [nondim]. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity [nondim]. @@ -270,7 +274,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - do K=1,nzc+1 ; kappa(K) = 1.0*US%m2_s_to_Z2_T ; enddo + do K=1,nzc+1 ; kappa(K) = CS%kappa_seed ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -356,8 +360,8 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. !! The previous value is used to initialize kappa - !! in the vertex columes as Kappa = Kv/Prandtl - !! to accelerate the iteration toward covergence. + !! in the vertex columns as Kappa = Kv/Prandtl + !! to accelerate the iteration toward convergence. real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. @@ -537,7 +541,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- - do K=1,nzc+1 ; kappa(K) = 1.0*US%m2_s_to_Z2_T ; enddo + do K=1,nzc+1 ; kappa(K) = CS%kappa_seed ; enddo call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & @@ -649,8 +653,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & ! 1/dz_Int, as they have different uses. S2, & ! The squared shear at an interface [T-2 ~> s-2]. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, - ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] - c1, & ! c1 is used in the tridiagonal (and similar) solvers. + ! velocity, and density equations [Z ~> m] + c1, & ! c1 is used in the tridiagonal (and similar) solvers [nondim]. k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. kappa_out, & ! The kappa that results from the kappa equation [Z2 T-1 ~> m2 s-1]. @@ -660,8 +664,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & pressure, & ! The pressure at an interface [R L2 T-2 ~> Pa]. T_int, & ! The temperature interpolated to an interface [C ~> degC]. Sal_int, & ! The salinity interpolated to an interface [S ~> ppt]. - dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z T-2 C-1 ~> m s-2 degC-1] and [Z T-2 S-1 ~> m s-2 ppt-1]. + dbuoy_dT, & ! The partial derivative of buoyancy with changes in temperature [Z T-2 C-1 ~> m s-2 degC-1] + dbuoy_dS, & ! The partial derivative of buoyancy with changes in salinity [Z T-2 S-1 ~> m s-2 ppt-1] I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. K_Q, & ! Diffusivity divided by TKE [T ~> s]. @@ -675,9 +679,9 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, dz, & ! sources from the elliptic term [T-1 ~> s-1]. real :: dist_from_bot ! The distance from the bottom surface [Z ~> m]. - real :: b1 ! The inverse of the pivot in the tridiagonal equations. - real :: bd1 ! A term in the denominator of b1. - real :: d1 ! 1 - c1 in the tridiagonal equations. + real :: b1 ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. + real :: bd1 ! A term in the denominator of b1 [Z ~> m]. + real :: d1 ! 1 - c1 in the tridiagonal equations [nondim] real :: gR0 ! A conversion factor from Z to pressure, given by Rho_0 times g ! [R L2 T-2 Z-1 ~> kg m-2 s-2]. real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z R-1 T-2 ~> m4 kg-1 s-2]. @@ -1060,10 +1064,11 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int !! diffusivity. ! Local variables - real, dimension(nz+1) :: c1 - real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared [Z2 s2 T-2 m-2 ~> 1]. - real :: a_a, a_b, b1, d1, bd1, b1nz_0 + real, dimension(nz+1) :: c1 ! A tridiagonal variable [nondim] + real :: a_a, a_b ! Tridiagonal coupling coefficients [Z ~> m] + real :: b1, b1nz_0 ! Tridiagonal variables [Z-1 ~> m-1] + real :: bd1 ! A term in the denominator of b1 [Z ~> m] + real :: d1 ! A tridiagonal variable [nondim] integer :: k, ks, ke ks = 1 ; ke = nz @@ -1131,16 +1136,14 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, dz, I_dz_int endif ! Store the squared shear at interfaces - ! L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 - L2_to_Z2 = US%L_to_Z**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & - S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) + S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (US%L_to_Z*I_dz_int(ks))**2 do K=ks+1,ke - S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (L2_to_Z2*I_dz_int(K)**2) + S2(K) = ((u(k)-u(k-1))**2 + (v(k)-v(k-1))**2) * (US%L_to_Z*I_dz_int(K))**2 enddo if (ke m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces - !! [Z-1 ~> m-1]. + !! [Z ~> m]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to !! boundaries [Z-2 ~> m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. @@ -1203,7 +1206,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [T ~> s]. dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [T-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the - ! TKE of the layer above when all the kappas below are 0. + ! TKE of the layer above when all the kappas below are 0 [nondim]. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear ! and stratification [Z2 T-3 ~> m2 s-3]. (For convenience, @@ -1213,13 +1216,13 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. real :: bQd1 ! A term in the denominator of bQ [Z T-1 ~> m s-1]. real :: bKd1 ! A term in the denominator of bK [Z ~> m]. - real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. + real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations [nondim]. real :: c_s2 ! The coefficient for the decay of TKE due to - ! shear (i.e. proportional to |S|*tke), nondimensional. + ! shear (i.e. proportional to |S|*tke) [nondim]. real :: c_n2 ! The coefficient for the decay of TKE due to ! stratification (i.e. proportional to N*tke) [nondim]. real :: Ri_crit ! The critical shear Richardson number for shear- - ! driven mixing. The theoretical value is 0.25. + ! driven mixing [nondim]. The theoretical value is 0.25. real :: q0 ! The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be @@ -1227,31 +1230,33 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & real :: kappa0 ! The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. - real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. + real :: eden1, eden2 ! Variables used in calculating e1 [Z-1 ~> m-1] + real :: I_eden ! The inverse of the denominator in e1 [Z ~> m] + real :: ome ! Variables used in calculating e1 [nondim] real :: diffusive_src ! The diffusive source in the kappa equation [Z T-1 ~> m s-1]. real :: chg_by_k0 ! The value of k_src that leads to an increase of ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]. real :: kappa_mean ! A mean value of kappa [Z2 T-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next - ! iteration to use Newton's method. + ! iteration to use Newton's method [nondim]. ! Temporary variables used in the Newton's method iterations. - real :: decay_term_k ! The decay term in the diffusivity equation + real :: decay_term_k ! The decay term in the diffusivity equation [Z-1 ~> m-1] real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1] real :: I_Q ! The inverse of TKE [T2 Z-2 ~> s2 m-2] - real :: kap_src + real :: kap_src ! A source term in the kappa equation [Z T-1 ~> m s-1] real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] - real :: v2 - real :: tol_err ! The tolerance for max_err that determines when to - ! stop iterating. - real :: Newton_err ! The tolerance for max_err that determines when to - ! start using Newton's method. Empirically, an initial - ! value of about 0.2 seems to be most efficient. - real, parameter :: roundoff = 1.0e-16 ! A negligible fractional change in TKE. - ! This could be larger but performance gains are small. + real :: v2 ! A temporary variable in [Z T-2 ~> m s-2] + real :: tol_err ! The tolerance for max_err that determines when to + ! stop iterating [nondim]. + real :: Newton_err ! The tolerance for max_err that determines when to + ! start using Newton's method [nondim]. Empirically, an initial + ! value of about 0.2 seems to be most efficient. + real, parameter :: roundoff = 1.0e-16 ! A negligible fractional change in TKE [nondim]. + ! This could be larger but performance gains are small. logical :: tke_noflux_bottom_BC = .false. ! Specify the boundary conditions - logical :: tke_noflux_top_BC = .false. ! that are applied to the TKE eqns. + logical :: tke_noflux_top_BC = .false. ! that are applied to the TKE equations. logical :: do_Newton ! If .true., use Newton's method for the next iteration. logical :: abort_Newton ! If .true., an Newton's method has encountered a 0 ! pivot, and should not have been used. @@ -1265,7 +1270,8 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! These variables are used only for debugging. logical, parameter :: debug_soln = .false. - real :: K_err_lin, Q_err_lin + real :: K_err_lin ! The imbalance in the K equation [Z T-1 ~> m s-1] + real :: Q_err_lin ! The imbalance in the Q equation [Z2 T-3 ~> m2 s-3] real, dimension(nz+1) :: & I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. @@ -1726,15 +1732,15 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) logical :: kappa_shear_init !< True if module is to be used, False otherwise ! Local variables + real :: KD_normal ! The KD of the main model, read here only as a parameter + ! for setting the default of KD_SMOOTH [Z2 T-1 ~> m2 s-1] + real :: kappa_0_default ! The default value for KD_KAPPA_SHEAR_0 [Z2 T-1 ~> m2 s-1] logical :: merge_mixedlayer logical :: debug_shear logical :: just_read ! If true, this module is not used, so only read the parameters. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name. - real :: kappa_0_unscaled ! The value of kappa_0 in MKS units [m2 s-1] - real :: KD_normal ! The KD of the main model, read here only as a parameter - ! for setting the default of KD_SMOOTH in MKS units [m2 s-1] if (associated(CS)) then call MOM_error(WARNING, "kappa_shear_init called with an associated "// & @@ -1776,17 +1782,25 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "The maximum number of iterations that may be used to "//& "estimate the Richardson number driven mixing.", & units="nondim", default=50, do_not_log=just_read) - call get_param(param_file, mdl, "KD", KD_normal, default=0.0, do_not_log=.true.) + call get_param(param_file, mdl, "KD", KD_normal, & + units="m2 s-1", scale=US%m2_s_to_Z2_T, default=0.0, do_not_log=.true.) + kappa_0_default = max(Kd_normal, 1.0e-7*US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the "//& "density and shear profiles before solving for the "//& "diffusivities. The default is the greater of KD and 1e-7 m2 s-1.", & - units="m2 s-1", default=max(KD_normal, 1.0e-7), scale=US%m2_s_to_Z2_T, & - unscaled=kappa_0_unscaled, do_not_log=just_read) + units="m2 s-1", default=kappa_0_default*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, & + do_not_log=just_read) + call get_param(param_file, mdl, "KD_SEED_KAPPA_SHEAR", CS%kappa_seed, & + "A moderately large seed value of diapycnal diffusivity that is used as a "//& + "starting turbulent diffusivity in the iterations to find an energetically "//& + "constrained solution for the shear-driven diffusivity.", & + units="m2 s-1", default=1.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_TRUNC_KAPPA_SHEAR", CS%kappa_trunc, & "The value of shear-driven diffusivity that is considered negligible "//& "and is rounded down to 0. The default is 1% of KD_KAPPA_SHEAR_0.", & - units="m2 s-1", default=0.01*kappa_0_unscaled, scale=US%m2_s_to_Z2_T, do_not_log=just_read) + units="m2 s-1", default=0.01*CS%kappa_0*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, & + do_not_log=just_read) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the "//& "Richardson number in the kappa source term in the "//& @@ -1831,7 +1845,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) default=.true., do_not_log=just_read) call get_param(param_file, mdl, "MAX_KAPPA_SHEAR_IT", CS%max_KS_it, & "The maximum number of iterations that may be used to "//& - "estimate the time-averaged diffusivity.", units="nondim", & + "estimate the time-averaged diffusivity.", & default=13, do_not_log=just_read) call get_param(param_file, mdl, "PRANDTL_TURB", CS%Prandtl_turb, & "The turbulent Prandtl number applied to shear instability.", & @@ -1950,7 +1964,7 @@ end function kappa_shear_at_vertex !! TKE with shear and stratification fixed, then marches the density !! and velocities forward with an adaptive (and aggressive) time step !! in a predictor-corrector-corrector emulation of a trapezoidal -!! scheme. Run-time-settable parameters determine the tolerence to +!! scheme. Run-time-settable parameters determine the tolerance to !! which the kappa and TKE equations are solved and the minimum time !! step that can be taken. diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index ccedb5c607..77de5d13cd 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -38,7 +38,7 @@ module MOM_opacity !< The maximum wavelength in each band of penetrating shortwave radiation [nm] real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next - !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. + !! sufficiently thick layer [C H T-1 ~> degC m s-1 or degC kg m-2 s-1]. real :: PenSW_absorb_Invlen !< The inverse of the thickness that is used to absorb the remaining !! shortwave heat flux when it drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]. integer :: answer_date !< The vintage of the order of arithmetic and expressions in the optics @@ -68,7 +68,7 @@ module MOM_opacity !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - logical :: warning_issued !< A flag that is used to avoid repetative warnings. + logical :: warning_issued !< A flag that is used to avoid repetitive warnings. !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 @@ -402,7 +402,7 @@ end subroutine opacity_from_chl !> This sets the blue-wavelength opacity according to the scheme proposed by !! Morel and Antoine (1994). function opacity_morel(chl_data) - real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. + real, intent(in) :: chl_data !< The chlorophyll-A concentration in [mg m-3] real :: opacity_morel !< The returned opacity [m-1] ! The following are coefficients for the optical model taken from Morel and @@ -411,8 +411,8 @@ function opacity_morel(chl_data) ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. real, dimension(6), parameter :: & - Z2_coef = (/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) - real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2. + Z2_coef = (/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) ! Extinction length coefficients [m] + real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2 [nondim] Chl = log10(min(max(chl_data,0.02),60.0)) ; Chl2 = Chl*Chl opacity_morel = 1.0 / ( (Z2_coef(1) + Z2_coef(2)*Chl) + Chl2 * & @@ -430,9 +430,9 @@ function SW_pen_frac_morel(chl_data) ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. - real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2. + real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2 [nondim] real, dimension(6), parameter :: & - V1_coef = (/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) + V1_coef = (/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) ! Penetrating fraction coefficients [nondim] Chl = log10(min(max(chl_data,0.02),60.0)) ; Chl2 = Chl*Chl SW_pen_frac_morel = 1.0 - ( (V1_coef(1) + V1_coef(2)*Chl) + Chl2 * & @@ -442,7 +442,7 @@ end function SW_pen_frac_morel !> This sets the blue-wavelength opacity according to the scheme proposed by !! Manizza, M. et al, 2005. function opacity_manizza(chl_data) - real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. + real, intent(in) :: chl_data !< The chlorophyll-A concentration [mg m-3] real :: opacity_manizza !< The returned opacity [m-1] ! This sets the blue-wavelength opacity according to the scheme proposed by Manizza, M. et al, 2005. @@ -460,15 +460,16 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), & optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer [Z-1 ~> m-1], !! but with units that can be altered by opacity_scale. - real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. + real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity [nondim] or + !! [Z H-1 ~> 1 or m3 kg-1] real, dimension(max(optics%nbands,1),SZI_(G)), & optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2] !! at the surface in each of the nbands bands !! that penetrates beyond the surface skin layer. - real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. + real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux [nondim]? ! Local variables - real :: scale_opacity, scale_penSW ! Rescaling factors + real :: scale_opacity, scale_penSW ! Rescaling factors [nondim]? integer :: i, is, ie, k, nz, n is = G%isc ; ie = G%iec ; nz = GV%ke @@ -604,7 +605,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! is moved upward [C H ~> degC m or degC kg m-2] real :: SWa ! fraction of the absorbed shortwave that is ! moved to layers above with adjustAbsorptionProfile [nondim] - real :: coSWa_frac ! The fraction of SWa that is actually moved upward. + real :: coSWa_frac ! The fraction of SWa that is actually moved upward [nondim] real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply ! absorbed in the next layer for computational efficiency, instead of ! continuing to penetrate [C H ~> degC m or degC kg m-2]. @@ -617,7 +618,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! was not entirely absorbed. logical :: TKE_calc ! If true, calculate the implications to the ! TKE budget of the shortwave heating. - real :: C1_6, C1_60 + real :: C1_6, C1_60 ! Rational fractions [nondim] integer :: is, ie, nz, i, k, ks, n if (nsw < 1) return @@ -830,7 +831,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & real :: SW_trans ! fraction of shortwave radiation not ! absorbed in a layer [nondim] real :: unabsorbed ! fraction of the shortwave radiation - ! not absorbed because the layers are too thin. + ! not absorbed because the layers are too thin [nondim]. real :: Ih_limit ! inverse of the total depth at which the ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index deb1c90ca9..5380b4cda0 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -34,6 +34,10 @@ module MOM_regularize_layers real :: density_match_tol !< A relative tolerance for how well the densities must match !! with the target densities during detrainment when regularizing !! the near-surface layers [nondim] + real :: sufficient_adjustment !< The fraction of the target entrainment of mass to the mixed + !! and buffer layers that is enough for one timestep when regularizing + !! the near-surface layers [nondim]. No more mass will be sought from + !! deeper layers in the interior after this fraction is exceeded. real :: h_def_tol1 !< The value of the relative thickness deficit at !! which to start modifying the structure, 0.5 by !! default (or a thickness ratio of 5.83) [nondim]. @@ -75,7 +79,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a @@ -86,7 +90,7 @@ subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control structure if (.not. CS%initialized) call MOM_error(FATAL, "MOM_regularize_layers: "//& "Module must be initialized before it is used.") @@ -107,7 +111,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs. + !! have NULL pointers. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a @@ -118,7 +122,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) !! this should be increased due to mixed layer !! entrainment [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control structure ! Local variables real, dimension(SZIB_(G),SZJ_(G)) :: & @@ -138,7 +142,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) S_2d, & ! A 2-d version of tv%S [S ~> ppt]. Rcv, & ! A 2-d version of the coordinate density [R ~> kg m-3]. h_2d_init, & ! The initial value of h_2d [H ~> m or kg m-2]. - T_2d_init, & ! THe initial value of T_2d [C ~> degC]. + T_2d_init, & ! The initial value of T_2d [C ~> degC]. S_2d_init, & ! The initial value of S_2d [S ~> ppt]. d_eb, & ! The downward increase across a layer in the entrainment from ! below [H ~> m or kg m-2]. The sign convention is that positive values of @@ -149,18 +153,19 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) real, dimension(SZI_(G)) :: & p_ref_cv, & ! Reference pressure for the potential density which defines ! the coordinate variable, set to P_Ref [R L2 T-2 ~> Pa]. - Rcv_tol, & ! A tolerence, relative to the target density differences + Rcv_tol, & ! A tolerance, relative to the target density differences ! between layers, for detraining into the interior [nondim]. - h_add_tgt, h_add_tot, & - h_tot1, Th_tot1, Sh_tot1, & - h_tot3, Th_tot3, Sh_tot3, & - h_tot2, Th_tot2, Sh_tot2 + h_add_tgt, & ! The target for the thickness to add to the mixed layers [H ~> m or kg m-2] + h_add_tot, & ! The net thickness added to the mixed layers [H ~> m or kg m-2] + h_tot1, h_tot2, h_tot3, & ! Debugging diagnostics of total thicknesses [H ~> m or kg m-2] + Th_tot1, Th_tot2, Th_tot3, & ! Debugging diagnostics of integrated temperatures [C H ~> degC m or degC kg m-2] + Sh_tot1, Sh_tot2, Sh_tot3 ! Debugging diagnostics of integrated salinities [S H ~> ppt m or ppt kg m-2] real, dimension(SZK_(GV)) :: & h_prev_1d ! The previous thicknesses [H ~> m or kg m-2]. real :: I_dtol ! The inverse of the tolerance changes [nondim]. real :: I_dtol34 ! The inverse of the tolerance changes [nondim]. real :: e_e, e_w, e_n, e_s ! Temporary interface heights [H ~> m or kg m-2]. - real :: wt ! The weight of the filted interfaces in setting the targets [nondim]. + real :: wt ! The weight of the filtered interfaces in setting the targets [nondim]. real :: scale ! A scaling factor [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -168,16 +173,17 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) int_flux, & ! Mass flux across the interfaces [H ~> m or kg m-2] int_Tflux, & ! Temperature flux across the interfaces [C H ~> degC m or degC kg m-2] int_Sflux ! Salinity flux across the interfaces [S H ~> ppt m or ppt kg m-2] - real :: h_add - real :: h_det_tot - real :: max_def_rat - real :: Rcv_min_det ! The lightest (min) and densest (max) coordinate density - real :: Rcv_max_det ! that can detrain into a layer [R ~> kg m-3]. - - real :: int_top, int_bot - real :: h_predicted - real :: h_prev - real :: h_deficit + real :: h_add ! The thickness to add to the layers above an interface [H ~> m or kg m-2] + real :: h_det_tot ! The total thickness detrained by the mixed layers [H ~> m or kg m-2] + real :: max_def_rat ! The maximum value of the ratio of the thickness deficit to the minimum depth [nondim] + real :: Rcv_min_det ! The lightest coordinate density that can detrain into a layer [R ~> kg m-3] + real :: Rcv_max_det ! The densest coordinate density that can detrain into a layer [R ~> kg m-3] + + real :: int_top, int_bot ! The interface depths above and below a layer [H ~> m or kg m-2], positive upward. + real :: h_predicted ! An updated thickness [H ~> m or kg m-2] + real :: h_prev ! The previous thickness [H ~> m or kg m-2] + real :: h_deficit ! The difference between the layer thickness and the value estimated from the + ! filtered interface depths [H ~> m or kg m-2] logical :: cols_left, ent_any, more_ent_i(SZI_(G)), ent_i(SZI_(G)) logical :: det_any, det_i(SZI_(G)) @@ -319,7 +325,7 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) S_2d(i,nkmb) = (h_prev*S_2d(i,nkmb) + h_add*S_2d(i,k)) / h_2d(i,nkmb) if ((e_2d(i,nkmb+1) <= e_filt(i,nkmb+1)) .or. & - (h_add_tot(i) > 0.6*h_add_tgt(i))) then !### 0.6 is adjustable?. + (h_add_tot(i) > CS%sufficient_adjustment*h_add_tgt(i))) then more_ent_i(i) = .false. else cols_left = .true. @@ -600,7 +606,7 @@ end subroutine regularize_surface !> This subroutine determines the amount by which the harmonic mean !! thickness at velocity points differ from the arithmetic means, relative to -!! the the arithmetic means, after eliminating thickness variations that are +!! the arithmetic means, after eliminating thickness variations that are !! solely due to topography and aggregating all interior layers into one. subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -613,7 +619,7 @@ subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, h) real, dimension(SZI_(G),SZJB_(G)), & intent(out) :: def_rat_v !< The thickness deficit ratio at v points, !! [nondim]. - type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(in) :: CS !< Regularize layer control structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -708,7 +714,7 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) !! run-time parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate !! diagnostic output. - type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control struct + type(regularize_layers_CS), intent(inout) :: CS !< Regularize layer control structure # include "version_variable.h" character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. @@ -746,6 +752,11 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) "densities during detrainment when regularizing the near-surface layers. The "//& "default of 0.6 gives 20% overlaps in density", & units="nondim", default=0.6, do_not_log=just_read) + call get_param(param_file, mdl, "REG_SFC_SUFFICIENT_ADJ", CS%sufficient_adjustment, & + "The fraction of the target entrainment of mass to the mixed and buffer layers "//& + "that is enough for one timestep when regularizing the near-surface layers. "//& + "No more mass will be sought from deeper layers in the interior after this "//& + "fraction is exceeded.", units="nondim", default=0.6, do_not_log=just_read) call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & default=99991231, do_not_log=just_read) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 6d35616b3a..0dec7a40c0 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -69,8 +69,7 @@ module MOM_set_diffusivity !! drag law c_drag*|u|*u. logical :: BBL_mixing_as_max !< If true, take the maximum of the diffusivity !! from the BBL mixing and the other diffusivities. - !! Otherwise, diffusivities from the BBL_mixing is - !! added. + !! Otherwise, diffusivities from the BBL_mixing is added. logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. real :: Von_Karm !< The von Karman constant as used in the BBL diffusivity calculation @@ -115,10 +114,9 @@ module MOM_set_diffusivity !! is the rotation rate of the earth squared. real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence !! radiated from the base of the mixed layer [Z2 T-1 ~> m2 s-1]. - real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth - real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to - !! obtain energy available for mixing below - !! mixed layer base [nondim] + real :: ML_rad_efold_coeff !< Coefficient to scale penetration depth [nondim] + real :: ML_rad_coeff !< Coefficient which scales MSTAR*USTAR^3 to obtain energy + !! available for mixing below mixed layer base [nondim] logical :: ML_rad_bug !< If true use code with a bug that reduces the energy available !! in the transition layer by a factor of the inverse of the energy !! deposition lenthscale (in m). @@ -135,7 +133,7 @@ module MOM_set_diffusivity !! of the vertical component of rotation when !! setting the decay scale for mixed layer turbulence. real :: ML_omega_frac !< When setting the decay scale for turbulence, use - !! this fraction of the absolute rotation rate blended + !! this fraction [nondim] of the absolute rotation rate blended !! with the local value of f, as f^2 ~= (1-of)*f^2 + of*4*omega^2. logical :: user_change_diff !< If true, call user-defined code to change diffusivity. logical :: useKappaShear !< If true, use the kappa_shear module to find the @@ -149,9 +147,9 @@ module MOM_set_diffusivity logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that !! does not rely on a layer-formulation. - real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering + real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering [nondim] real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] - real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] + real :: Kv_molecular !< Molecular viscosity for double diffusive convection [Z2 T-1 ~> m2 s-1] integer :: answer_date !< The vintage of the order of arithmetic and expressions in this module's !! calculations. Values below 20190101 recover the answers from the @@ -185,9 +183,9 @@ module MOM_set_diffusivity Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [R Z3 T-3 ~> W m-2] maxTKE => NULL(), & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] Kd_bkgnd => NULL(), & !< Background diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - Kv_bkgnd => NULL(), & !< Viscosity from ackground diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - KT_extra => NULL(), & !< double diffusion diffusivity for temp [Z2 T-1 ~> m2 s-1]. - KS_extra => NULL(), & !< double diffusion diffusivity for saln [Z2 T-1 ~> m2 s-1]. + Kv_bkgnd => NULL(), & !< Viscosity from background diffusivity at interfaces [Z2 T-1 ~> m2 s-1] + KT_extra => NULL(), & !< Double diffusion diffusivity for temperature [Z2 T-1 ~> m2 s-1]. + KS_extra => NULL(), & !< Double diffusion diffusivity for salinity [Z2 T-1 ~> m2 s-1]. drho_rat => NULL() !< The density difference ratio used in double diffusion [nondim]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE @@ -262,8 +260,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i Kd_int_2d, & !< The interface diffusivities [Z2 T-1 ~> m2 s-1] Kv_bkgnd, & !< The background diffusion related interface viscosities [Z2 T-1 ~> m2 s-1] dRho_int, & !< Locally referenced potential density difference across interfaces [R ~> kg m-3] - KT_extra, & !< Double difusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] - KS_extra !< Double difusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] + KT_extra, & !< Double diffusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] + KS_extra !< Double diffusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] real :: dissip ! local variable for dissipation calculations [Z2 R T-3 ~> W m-3] real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] @@ -673,7 +671,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(out) :: TKE_to_Kd !< The conversion rate between the !! TKE dissipated within a layer and the - !! diapycnal diffusivity witin that layer, + !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain @@ -701,12 +699,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & Rcv_kmb, & ! coordinate density in the lowest buffer layer [R ~> kg m-3] p_0 ! An array of 0 pressures [R L2 T-2 ~> Pa] - real :: dh_max ! maximum amount of entrainment a layer could - ! undergo before entraining all fluid in the layers - ! above or below [Z ~> m]. + real :: dh_max ! maximum amount of entrainment a layer could undergo before + ! entraining all fluid in the layers above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [R ~> kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z T-2 R-1 ~> m4 s-2 kg-1] + real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density [Z T-2 R-1 ~> m4 s-2 kg-1] real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z T-2 R-1 ~> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [R-1 ~> m3 kg-1] real :: I_dt ! 1/dt [T-1 ~> s-1] @@ -903,7 +900,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real, dimension(SZI_(G)) :: & pres, & ! pressure at each interface [R L2 T-2 ~> Pa] - Temp_int, & ! temperature at each interface [C ~>degC] + Temp_int, & ! temperature at each interface [C ~> degC] Salin_int, & ! salinity at each interface [S ~> ppt] drho_bot, & ! A density difference [R ~> kg m-3] h_amp, & ! The topographic roughness amplitude [Z ~> m]. @@ -911,16 +908,16 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & z_from_bot ! The hieght above the bottom [Z ~> m]. real :: dz_int ! thickness associated with an interface [Z ~> m]. - real :: G_Rho0 ! gravitation acceleration divided by Bouss reference density + real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density ! times some unit conversion factors [Z T-2 R-1 ~> m4 s-2 kg-1]. - real :: H_neglect ! negligibly small thickness, in the same units as h. + real :: H_neglect ! A negligibly small thickness [H ~> m or kg m-2] logical :: do_i(SZI_(G)), do_any integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = GV%ke - G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / (GV%Rho0) + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1064,8 +1061,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp [R C-1 ~> kg m-3 degC-1] - dRho_dS, & ! partial derivatives of density wrt saln [R S-1 ~> kg m-3 ppt-1] + dRho_dT, & ! partial derivatives of density with respect to temperature [R C-1 ~> kg m-3 degC-1] + dRho_dS, & ! partial derivatives of density with respect to salinity [R S-1 ~> kg m-3 ppt-1] pres, & ! pressure at each interface [R L2 T-2 ~> Pa] Temp_int, & ! temperature at interfaces [C ~> degC] Salin_int ! Salinity at interfaces [S ~> ppt] @@ -1076,7 +1073,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real :: Rrho ! vertical density ratio [nondim] real :: diff_dd ! factor for double-diffusion [nondim] real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 T-1 ~> m2 s-1] - real :: prandtl ! flux ratio for diffusive convection regime + real :: prandtl ! flux ratio for diffusive convection regime [nondim] real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim] @@ -1146,7 +1143,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the - !! diapycnal diffusivity witin that layer, + !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain @@ -1274,7 +1271,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! if (maxEnt(i,k) <= 0.0) cycle if (maxTKE(i,k) <= 0.0) cycle - ! This is an analytic integral where diffusity is a quadratic function of + ! This is an analytic integral where diffusivity is a quadratic function of ! rho that goes asymptotically to 0 at Rho_top (vaguely following KPP?). if (TKE(i) > 0.0) then if (Rint(K) <= Rho_top(i)) then @@ -1395,7 +1392,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int real :: ustar ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: ustar2 ! square of ustar, for convenience [Z2 T-2 ~> m2 s-2] real :: absf ! average absolute value of Coriolis parameter around a thickness point [T-1 ~> s-1] - real :: dh, dhm1 ! thickness of layers k and k-1, respecitvely [Z ~> m]. + real :: dh, dhm1 ! thickness of layers k and k-1, respectively [Z ~> m]. real :: z_bot ! distance to interface k from bottom [Z ~> m]. real :: D_minus_z ! distance to interface k from surface [Z ~> m]. real :: total_thickness ! total thickness of water column [Z ~> m]. @@ -1550,7 +1547,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]. real :: ustar_sq ! ustar squared [Z2 T-2 ~> m2 s-2] real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 T-1 ~> m2 s-1]. - real :: C1_6 ! 1/6 + real :: C1_6 ! 1/6 [nondim] real :: Omega2 ! rotation rate squared [T-2 ~> s-2]. real :: z1 ! layer thickness times I_decay [nondim] real :: dzL ! thickness converted to heights [Z ~> m]. @@ -1623,7 +1620,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) if (CS%ML_Rad_bug) then - ! These expresssions are dimensionally inconsistent. -RWH + ! These expressions are dimensionally inconsistent. -RWH ! This is supposed to be the integrated energy deposited in the layer, ! not the average over the layer as in these expressions. if (z1 > 1e-5) then @@ -1881,8 +1878,8 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) ! Local variables real :: g_R0 ! g_R0 is a rescaled version of g/Rho [L2 Z-1 R-1 T-2 ~> m4 kg-1 s-2] - real :: eps, tmp ! nondimensional temporary variables - real :: a(SZK_(GV)), a_0(SZK_(GV)) ! nondimensional temporary variables + real :: eps, tmp ! nondimensional temporary variables [nondim] + real :: a(SZK_(GV)), a_0(SZK_(GV)) ! nondimensional temporary variables [nondim] real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures [R L2 T-2 ~> Pa] real :: Rcv(SZI_(G),SZK_(GV)) ! coordinate density in the mixed and buffer layers [R ~> kg m-3] real :: I_Drho ! temporary variable [R-1 ~> m3 kg-1] @@ -1950,7 +1947,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) do k3=2,kmb ! ds_dsp1(i,k3) = MAX(a(k3),1e-5) - ! Deliberately treat convective instabilies of the upper mixed + ! Deliberately treat convective instabilities of the upper mixed ! and buffer layers with respect to the deepest buffer layer as ! though they don't exist. They will be eliminated by the upcoming ! call to the mixedlayer code anyway. @@ -1974,7 +1971,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output. type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control !! structure. - type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control struct + type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control structure integer, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. logical, intent(out) :: double_diffuse !< This indicates whether some version @@ -1986,7 +1983,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ !! surface boundary layer. ! Local variables - real :: decay_length + real :: decay_length ! The maximum decay scale for the BBL diffusion [Z ~> m] logical :: ML_use_omega integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -1996,7 +1993,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. - real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nomdim] + real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nondim] real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate ! that is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] @@ -2176,7 +2173,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "for an isopycnal layer-formulation.", & default=.false., do_not_log=.not.TKE_to_Kd_used) - ! set params related to the background mixing + ! set parameters related to the background mixing call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp, physical_OBL_scheme) call get_param(param_file, mdl, "KV", CS%Kv, & @@ -2340,7 +2337,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ end subroutine set_diffusivity_init -!> Clear pointers and dealocate memory +!> Clear pointers and deallocate memory subroutine set_diffusivity_end(CS) type(set_diffusivity_CS), intent(inout) :: CS !< Control structure for this module diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 80be1ed12f..1e3bf258d8 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -4,37 +4,39 @@ module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : uvchksum, hchksum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_ALE, only : ALE_CS, ALE_remap_velocities, ALE_remap_interface_vals, ALE_remap_vertex_vals +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_debugging, only : uvchksum, hchksum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type -use MOM_domains, only : pass_var, CORNER +use MOM_domains, only : pass_var, CORNER use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : slasher, MOM_read_data -use MOM_kappa_shear, only : kappa_shear_is_used, kappa_shear_at_vertex -use MOM_cvmix_shear, only : cvmix_shear_is_used -use MOM_cvmix_conv, only : cvmix_conv_is_used -use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used -use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS -use MOM_restart, only : register_restart_field_as_obsolete -use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : slasher, MOM_read_data +use MOM_kappa_shear, only : kappa_shear_is_used, kappa_shear_at_vertex +use MOM_cvmix_shear, only : cvmix_shear_is_used +use MOM_cvmix_conv, only : cvmix_conv_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_restart, only : register_restart_field_as_obsolete +use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_open_boundary, only : OBC_segment_type + implicit none ; private #include public set_viscous_BBL, set_viscous_ML, set_visc_init, set_visc_end -public set_visc_register_restarts +public set_visc_register_restarts, remap_vertvisc_aux_vars ! 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 @@ -46,10 +48,10 @@ module MOM_set_visc logical :: initialized = .false. !< True if this control structure has been initialized. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. !! Runtime parameter `HBBL`. - real :: cdrag !< The quadratic drag coefficient. + real :: cdrag !< The quadratic drag coefficient [nondim]. !! Runtime parameter `CDRAG`. real :: c_Smag !< The Laplacian Smagorinsky coefficient for - !! calculating the drag in channels. + !! calculating the drag in channels [nondim]. real :: drag_bg_vel !< An assumed unresolved background velocity for !! calculating the bottom drag [L T-1 ~> m s-1]. !! Runtime parameter `DRAG_BG_VEL`. @@ -77,7 +79,7 @@ module MOM_set_visc logical :: Channel_drag !< If true, the drag is exerted directly on each layer !! according to what fraction of the bottom they overlie. real :: Chan_drag_max_vol !< The maximum bottom boundary layer volume within which the - !! channel drag is applied, normalized by the the full cell area, + !! channel drag is applied, normalized by the full cell area, !! or a negative value to apply no maximum [H ~> m or kg m-2]. logical :: correct_BBL_bounds !< If true, uses the correct bounds on the BBL thickness and !! viscosity so that the bottom layer feels the intended drag. @@ -134,7 +136,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields - !! have NULL ptrs. + !! have NULL pointers. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous @@ -231,7 +233,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: C24_a ! 24/a [H-1 ~> m-1 or m2 kg-1]. real :: slope ! The absolute value of the bottom depth slope across ! a cell times the cell width [H ~> m or kg m-2]. - real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope. + real :: apb_4a, ax2_3apb ! Various nondimensional ratios of a and slope [nondim]. real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope [H-1 ~> m-1 or m2 kg-1]. ! All of the following "volumes" have units of thickness because they are normalized ! by the full horizontal area of a velocity cell. @@ -255,8 +257,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! the depth of each interface [nondim]. real :: L_direct ! The value of L above volume Vol_direct [nondim]. real :: L_max, L_min ! Upper and lower bounds on the correct value for L [nondim]. - real :: Vol_err_max ! The volume errors for the upper and lower bounds on - real :: Vol_err_min ! the correct value for L [H ~> m or kg m-2]. + real :: Vol_err_max ! The volume error for the upper bound on the correct value for L [H ~> m or kg m-2] + real :: Vol_err_min ! The volume error for the lower bound on the correct value for L [H ~> m or kg m-2] real :: Vol_0 ! A deeper volume with known width L0 [H ~> m or kg m-2]. real :: L0 ! The value of L above volume Vol_0 [nondim]. real :: dVol ! vol - Vol_0 [H ~> m or kg m-2]. @@ -280,12 +282,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: h_bbl_fr ! The fraction of the bottom boundary layer in a layer [nondim]. real :: h_sum ! The sum of the thicknesses of the layers below the one being ! worked on [H ~> m or kg m-2]. - real, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 - real :: C2pi_3 ! An irrational constant, 2/3 pi. - real :: tmp ! A temporary variable. - real :: tmp_val_m1_to_p1 + real, parameter :: C1_3 = 1.0/3.0, C1_6 = 1.0/6.0, C1_12 = 1.0/12.0 ! Rational constants [nondim] + real :: C2pi_3 ! An irrational constant, 2/3 pi. [nondim] + real :: tmp ! A temporary variable, sometimes in [Z ~> m] + real :: tmp_val_m1_to_p1 ! A temporary variable [nondim] real :: curv_tol ! Numerator of curvature cubed, used to estimate - ! accuracy of a single L(:) Newton iteration + ! accuracy of a single L(:) Newton iteration [H5 ~> m5 or kg5 m-10] logical :: use_L0, do_one_L_iter ! Control flags for L(:) Newton iteration logical :: use_BBL_EOS, do_i(SZIB_(G)) integer, dimension(2) :: EOSdom ! The computational domain for the equation of state @@ -1097,7 +1099,7 @@ function set_v_at_u(v, h, G, GV, i, j, k, mask2dCv, OBC) integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. real, dimension(SZI_(G),SZJB_(G)),& - intent(in) :: mask2dCv !< A multiplicative mask of the v-points + intent(in) :: mask2dCv !< A multiplicative mask of the v-points [nondim] type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure real :: set_v_at_u !< The return value of v at u points points in the !! same units as u, i.e. [L T-1 ~> m s-1] or other units. @@ -1142,7 +1144,7 @@ function set_u_at_v(u, h, G, GV, i, j, k, mask2dCu, OBC) integer, intent(in) :: j !< The j-index of the u-location to work on. integer, intent(in) :: k !< The k-index of the u-location to work on. real, dimension(SZIB_(G),SZJ_(G)), & - intent(in) :: mask2dCu !< A multiplicative mask of the u-points + intent(in) :: mask2dCu !< A multiplicative mask of the u-points [nondim] type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure real :: set_u_at_v !< The return value of u at v points in the !! same units as u, i.e. [L T-1 ~> m s-1] or other units. @@ -1192,7 +1194,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available !! thermodynamic fields. Absent fields have - !! NULL ptrs. + !! NULL pointers. type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and !! related fields. @@ -1211,8 +1213,10 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) Rhtot, & ! The integrated density of layers that are within the surface mixed layer ! [H R ~> kg m-2 or kg2 m-5]. Rhtot is only used if no ! equation of state is used. - uhtot, & ! The depth integrated zonal and meridional velocities within - vhtot, & ! the surface mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + uhtot, & ! The depth integrated zonal velocity within the surface + ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. + vhtot, & ! The depth integrated meridional velocity within the surface + ! mixed layer [H L T-1 ~> m2 s-1 or kg m-1 s-1]. Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. dR_dT, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with temperature [R C-1 ~> kg m-3 degC-1]. @@ -1236,7 +1240,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) ! viscous mixed layer. real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the - ! interior layer layer times the depth of the the mixed layer + ! interior layer layer times the depth of the mixed layer ! [H2 L2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate @@ -1253,14 +1257,13 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) real :: S_lay ! The layer salinity at velocity points [S ~> ppt]. real :: Rlay ! The layer potential density at velocity points [R ~> kg m-3]. real :: Rlb ! The potential density of the layer below [R ~> kg m-3]. - real :: v_at_u ! The meridonal velocity at a zonal velocity point [L T-1 ~> m s-1]. - real :: u_at_v ! The zonal velocity at a meridonal velocity point [L T-1 ~> m s-1]. + real :: v_at_u ! The meridional velocity at a zonal velocity point [L T-1 ~> m s-1]. + real :: u_at_v ! The zonal velocity at a meridional velocity point [L T-1 ~> m s-1]. real :: gHprime ! The mixed-layer internal gravity wave speed squared, based ! on the mixed layer thickness and density difference across ! the base of the mixed layer [L2 T-2 ~> m2 s-2]. real :: RiBulk ! The bulk Richardson number below which water is in the - ! viscous mixed layer, including reduction for turbulent - ! decay. Nondimensional. + ! viscous mixed layer, including reduction for turbulent decay [nondim] real :: dt_Rho0 ! The time step divided by the conversion from the layer ! thickness to layer mass [T H Z-1 R-1 ~> s m3 kg-1 or s]. real :: g_H_Rho0 ! The gravitational acceleration times the conversion from H to m divided @@ -1863,13 +1866,13 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical !! viscosities and related fields. !! Allocated here. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL logical :: use_CVMix_shear, MLE_use_PBL_MLD, use_CVMix_conv integer :: isd, ied, jsd, jed, nz - real :: hfreeze !< If hfreeze > 0 [m], melt potential will be computed. + real :: hfreeze !< If hfreeze > 0 [Z ~> m], melt potential will be computed. character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -1927,7 +1930,7 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) default=.false., do_not_log=.true.) ! visc%MLD needs to be allocated when melt potential is computed (HFREEZE>0) call get_param(param_file, mdl, "HFREEZE", hfreeze, & - default=-1.0, do_not_log=.true.) + units="m", default=-1.0, scale=US%m_to_Z, do_not_log=.true.) if (MLE_use_PBL_MLD) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) @@ -1942,6 +1945,34 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) end subroutine set_visc_register_restarts +!> This subroutine does remapping for the auxiliary restart variables in a vertvisc_type +!! that are used across timesteps +subroutine remap_vertvisc_aux_vars(G, GV, visc, h_old, h_new, ALE_CSp, OBC) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + !! viscosities and related fields. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_old !< Thickness of source grid [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_new !< Thickness of destination grid [H ~> m or kg m-2] + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure to use when remapping + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + + if (associated(visc%Kd_shear)) then + call ALE_remap_interface_vals(ALE_CSp, G, GV, h_old, h_new, visc%Kd_shear) + endif + + if (associated(visc%Kv_shear)) then + call ALE_remap_interface_vals(ALE_CSp, G, GV, h_old, h_new, visc%Kv_shear) + endif + + if (associated(visc%Kv_shear_Bu)) then + call ALE_remap_vertex_vals(ALE_CSp, G, GV, h_old, h_new, visc%Kv_shear_Bu) + endif + +end subroutine remap_vertvisc_aux_vars + !> Initializes the MOM_set_visc control structure subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS, OBC) type(time_type), target, intent(in) :: Time !< The current model time. @@ -1953,29 +1984,31 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities and - !! related fields. Allocated here. - type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control struct - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + !! related fields. + type(set_visc_CS), intent(inout) :: CS !< Vertical viscosity control structure + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control structure type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure ! Local variables real :: Csmag_chan_dflt ! The default value for SMAG_CONST_CHANNEL [nondim] real :: smag_const1 ! The default value for the Smagorinsky Laplacian coefficient [nondim] - real :: TKE_decay_dflt ! The default value of a coeficient scaling the vertical decay + real :: TKE_decay_dflt ! The default value of a coefficient scaling the vertical decay ! rate of TKE [nondim] real :: bulk_Ri_ML_dflt ! The default bulk Richardson number for a bulk mixed layer [nondim] - real :: Kv_background ! The background kinematic viscosity in the interior [m2 s-1] + real :: Kv_background ! The background kinematic viscosity in the interior [Z2 T-1 ~> m2 s-1] real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate that ! is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] - real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [m] + real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [Z ~> m] + real :: Hbbl ! The static bottom boundary layer thickness [Z ~> m]. + real :: BBL_thick_min ! The minimum bottom boundary layer thickness [Z ~> m]. real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a restart file to the internal representation in this run. + ! a restart file to the internal representation in this run [nondim]? real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run - ! to the representation in a restart file. + ! to the representation in a restart file [nondim]? real :: Z2_T_rescale ! A rescaling factor for vertical diffusivities and viscosities from the - ! representation in a restart file to the internal representation in this run. + ! representation in a restart file to the internal representation in this run [nondim]? integer :: i, j, k, is, ie, js, je integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. @@ -1989,7 +2022,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS ! isopycnal or stacked shallow water mode. logical :: use_temperature ! If true, temperature and salinity are used as state variables. logical :: use_EOS ! If true, density calculated from T & S using an equation of state. - character(len=200) :: filename, tideamp_file + character(len=200) :: filename, tideamp_file ! Input file names or paths + character(len=80) :: tideamp_var ! Input file variable names ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. @@ -2069,28 +2103,26 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "determine the mixed layer thickness for viscosity.", & default=.false.) if (CS%dynamic_viscous_ML) then - call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, default=0.0) + call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, units="nondim", default=0.0) call get_param(param_file, mdl, "BULK_RI_ML_VISC", CS%bulk_Ri_ML, & - "The efficiency with which mean kinetic energy released "//& - "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy. By default, "//& - "BULK_RI_ML_VISC = BULK_RI_ML or 0.", units="nondim", & - default=bulk_Ri_ML_dflt) - call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, default=0.0) + "The efficiency with which mean kinetic energy released by mechanically "//& + "forced entrainment of the mixed layer is converted to turbulent "//& + "kinetic energy. By default, BULK_RI_ML_VISC = BULK_RI_ML or 0.", & + units="nondim", default=bulk_Ri_ML_dflt) + call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, units="nondim", default=0.0) call get_param(param_file, mdl, "TKE_DECAY_VISC", CS%TKE_decay, & "TKE_DECAY_VISC relates the vertical rate of decay of "//& "the TKE available for mechanical entrainment to the "//& "natural Ekman depth for use in calculating the dynamic "//& - "mixed layer viscosity. By default, "//& - "TKE_DECAY_VISC = TKE_DECAY or 0.", units="nondim", & - default=TKE_decay_dflt) + "mixed layer viscosity. By default, TKE_DECAY_VISC = TKE_DECAY or 0.", & + units="nondim", default=TKE_decay_dflt) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& - "scale for turbulence.", default=.false., do_not_log=.true.) + "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then - call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") + call MOM_error(WARNING, "ML_USE_OMEGA is deprecated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & @@ -2099,28 +2131,27 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=US%T_to_s) + "The rotation rate of the earth.", & + units="s-1", default=7.2921e-5, scale=US%T_to_s) endif - call get_param(param_file, mdl, "HBBL", CS%Hbbl, & + call get_param(param_file, mdl, "HBBL", Hbbl, & "The thickness of a bottom boundary layer with a viscosity increased by "//& "KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//& "near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//& "defined but LINEAR_DRAG is not.", & - units="m", fail_if_missing=.true.) ! Rescaled later + units="m", scale=US%m_to_Z, fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the bottom stress. CDRAG is only "//& - "used if BOTTOMDRAGLAW is defined.", units="nondim", & - default=0.003) + "used if BOTTOMDRAGLAW is defined.", units="nondim", default=0.003) call get_param(param_file, mdl, "BBL_USE_TIDAL_BG", CS%BBL_use_tidal_bg, & "Flag to use the tidal RMS amplitude in place of constant "//& "background velocity for computing u* in the BBL. "//& @@ -2130,6 +2161,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") else call get_param(param_file, mdl, "DRAG_BG_VEL", CS%drag_bg_vel, & "DRAG_BG_VEL is either the assumed bottom velocity (with "//& @@ -2152,25 +2186,26 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (use_regridding .and. (.not. CS%BBL_use_EOS)) & call MOM_error(FATAL,"When using MOM6 in ALE mode it is required to set BBL_USE_EOS to True.") endif - call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, & + call get_param(param_file, mdl, "BBL_THICK_MIN", BBL_thick_min, & "The minimum bottom boundary layer thickness that can be "//& "used with BOTTOMDRAGLAW. This might be "//& "Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//& - "near-bottom viscosity.", units="m", default=0.0) ! Rescaled later + "near-bottom viscosity.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & "The minimum top boundary layer thickness that can be "//& "used with BOTTOMDRAGLAW. This might be "//& "Kv/(cdrag*drag_bg_vel) to give Kv as the minimum "//& - "near-top viscosity.", units="m", default=CS%BBL_thick_min, scale=GV%m_to_H) + "near-top viscosity.", units="m", default=US%Z_to_m*BBL_thick_min, scale=GV%m_to_H) call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & "The thickness over which near-surface velocities are "//& "averaged for the drag law under an ice shelf. By "//& - "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) + "default this is the same as HBBL", & + units="m", default=US%Z_to_m*Hbbl, scale=GV%m_to_H) call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "USE_KPP", use_KPP, & "If true, turns on the [CVMix] KPP scheme of Large et al., 1994, "//& @@ -2179,17 +2214,17 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_background, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "CORRECT_BBL_BOUNDS", CS%correct_BBL_bounds, & "If true, uses the correct bounds on the BBL thickness and "//& "viscosity so that the bottom layer feels the intended drag.", & default=.false.) if (CS%Channel_drag) then - call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) + call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, units="nondim", default=-1.0) cSmag_chan_dflt = 0.15 if (smag_const1 >= 0.0) cSmag_chan_dflt = smag_const1 @@ -2204,26 +2239,25 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%c_Smag < 0.0) CS%c_Smag = 0.15 endif - Chan_max_thick_dflt = -1.0 - if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*CS%Hbbl - if (CS%body_force_drag) Chan_max_thick_dflt = CS%Hbbl + Chan_max_thick_dflt = -1.0*US%m_to_Z + if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*Hbbl + if (CS%body_force_drag) Chan_max_thick_dflt = Hbbl call get_param(param_file, mdl, "CHANNEL_DRAG_MAX_BBL_THICK", CS%Chan_drag_max_vol, & "The maximum bottom boundary layer thickness over which the channel drag is "//& "exerted, or a negative value for no fixed limit, instead basing the BBL "//& "thickness on the bottom stress, rotation and stratification. The default is "//& "proportional to HBBL if USE_JACKSON_PARAM or DRAG_AS_BODY_FORCE is true.", & - units="m", default=Chan_max_thick_dflt, scale=GV%m_to_H, & + units="m", default=US%Z_to_m*Chan_max_thick_dflt, scale=GV%m_to_H, & do_not_log=.not.CS%Channel_drag) call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & default=.false., do_not_log=.true.) - ! These unit conversions are out outside the get_param calls because they are also defaults. - CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale - CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale + CS%Hbbl = Hbbl * GV%Z_to_H ! Rescaled for later use + CS%BBL_thick_min = BBL_thick_min * GV%Z_to_H ! Rescaled for later use if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then - ! This is necessary for reproduciblity across restarts in non-symmetric mode. + ! This is necessary for reproducibility across restarts in non-symmetric mode. call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.) endif @@ -2257,7 +2291,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS 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) + call MOM_read_data(filename, tideamp_var, CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) call pass_var(CS%tideamp,G%domain) endif endif diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 48e9320c8e..0ef732a024 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -30,11 +30,11 @@ module MOM_sponge !> A structure for creating arrays of pointers to 3D arrays type, public :: p3d - real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array + real, dimension(:,:,:), pointer :: p => NULL() !< A pointer to a 3D array [various] end type p3d !> A structure for creating arrays of pointers to 2D arrays type, public :: p2d - real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array [various] end type p2d !> This control structure holds memory and parameters for the MOM_sponge module @@ -203,15 +203,15 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: sp_val !< The reference profiles of the quantity being registered. + intent(in) :: sp_val !< The reference profiles of the quantity being registered [various] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - target, intent(in) :: f_ptr !< a pointer to the field which will be damped + target, intent(in) :: f_ptr !< a pointer to the field which will be damped [various] integer, intent(in) :: nlay !< the number of layers in this quantity type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that !! is set by a previous call to initialize_sponge. real, dimension(SZJ_(G),SZK_(GV)),& optional, intent(in) :: sp_val_i_mean !< The i-mean reference value for - !! this field with i-mean sponges. + !! this field with i-mean sponges [various] integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -331,11 +331,11 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) eta_anom, & ! Anomalies in the interface height, relative to the i-mean ! target value [Z ~> m]. fld_anom ! Anomalies in a tracer concentration, relative to the - ! i-mean target value. + ! i-mean target value [various] real, dimension(SZJ_(G), SZK_(GV)+1) :: & eta_mean_anom ! The i-mean interface height anomalies [Z ~> m]. real, allocatable, dimension(:,:,:) :: & - fld_mean_anom ! THe i-mean tracer concentration anomalies. + fld_mean_anom ! The i-mean tracer concentration anomalies [various] real, dimension(SZI_(G), SZK_(GV)+1) :: & h_above, & ! The total thickness above an interface [H ~> m or kg m-2]. h_below ! The total thickness below an interface [H ~> m or kg m-2]. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 645a6ef491..430a9225b5 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -11,6 +11,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, MOM_read_data, field_size +use MOM_io, only : read_netCDF_data use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h use MOM_string_functions, only : uppercase, lowercase @@ -48,11 +49,11 @@ module MOM_tidal_mixing real, allocatable :: Kd_Niku_work(:,:,:) !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] - real, allocatable :: N2_int(:,:,:) !< Bouyancy frequency squared at interfaces [T-2 ~> s-2] - real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition [W m-3] - real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme, in UNITS? + real, allocatable :: N2_int(:,:,:) !< Buoyancy frequency squared at interfaces [T-2 ~> s-2] + real, allocatable :: vert_dep_3d(:,:,:) !< The 3-d mixing energy deposition vertical fraction [nondim]? + real, allocatable :: Schmittner_coeff_3d(:,:,:) !< The coefficient in the Schmittner et al mixing scheme [nondim] real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, - !! interpolated to model vertical coordinate [W m-3?] + !! interpolated to model vertical coordinate [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. real, allocatable :: Fl_lowmode(:,:,:) !< vertical flux of tidal turbulent @@ -61,8 +62,8 @@ module MOM_tidal_mixing real, allocatable :: N2_bot(:,:) !< bottom squared buoyancy frequency [T-2 ~> s-2] real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2] real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m] - real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal diss with Polzin [Z ~> m] - real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient + real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal dissipation with Polzin [Z ~> m] + real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient [nondim] end type !> Control structure with parameters for the tidal mixing module. @@ -123,19 +124,20 @@ module MOM_tidal_mixing real :: utide !< constant tidal amplitude [Z T-1 ~> m s-1] if READ_TIDEAMP is false. real :: kappa_itides !< topographic wavenumber and non-dimensional scaling [Z-1 ~> m-1]. - real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height + real :: kappa_h2_factor !< factor for the product of wavenumber * rms sgs height [nondim] character(len=200) :: inputdir !< The directory in which to find input files logical :: use_CVMix_tidal = .false. !< true if CVMix is to be used for determining !! diffusivity due to tidal mixing - real :: min_thickness !< Minimum thickness allowed [m] + real :: min_thickness !< Minimum thickness allowed [Z ~> m] ! CVMix-specific parameters integer :: CVMix_tidal_scheme = -1 !< 1 for Simmons, 2 for Schmittner type(CVMix_tidal_params_type) :: CVMix_tidal_params !< A CVMix-specific type with parameters for tidal mixing type(CVMix_global_params_type) :: CVMix_glb_params !< CVMix-specific for Prandtl number only - real :: tidal_max_coef !< CVMix-specific maximum allowable tidal diffusivity. [m^2/s] + real :: tidal_max_coef !< CVMix-specific maximum allowable tidal + !! diffusivity. [Z2 T-1 ~> m2 s-1] real :: tidal_diss_lim_tc !< CVMix-specific dissipation limit depth for !! tidal-energy-constituent data [Z ~> m]. type(remapping_CS) :: remap_CS !< The control structure for remapping @@ -154,17 +156,17 @@ module MOM_tidal_mixing real, allocatable :: TKE_Niku(:,:) !< Lee wave driven Turbulent Kinetic Energy input !! [R Z3 T-3 ~> W m-2] real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratfication [R Z3 T-2 ~> J m-2]. + !! by the bottom stratification [R Z3 T-2 ~> J m-2]. real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1]. - real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input + real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input [nondim] real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2]. real, allocatable :: tideamp(:,:) !< RMS tidal amplitude [Z T-1 ~> m s-1] real, allocatable :: h_src(:) !< tidal constituent input layer thickness [m] real, allocatable :: tidal_qe_2d(:,:) !< Tidal energy input times the local dissipation !! fraction, q*E(x,y), with the CVMix implementation - !! of Jayne et al tidal mixing [W m-2]. + !! of Jayne et al tidal mixing [R Z3 T-3 ~> W m-2]. !! TODO: make this E(x,y) only - real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + real, allocatable :: tidal_qe_3d_in(:,:,:) !< q*E(x,y,z) with the Schmittner parameterization [R Z3 T-3 ~> W m-2] ! Diagnostics @@ -236,10 +238,15 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di ! forms of the same expressions. character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type - character(len=200) :: filename, h2_file, Niku_TKE_input_file - character(len=200) :: tidal_energy_file, tideamp_file - real :: utide, hamp, prandtl_tidal, max_frac_rough - real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data + character(len=200) :: filename, h2_file, Niku_TKE_input_file ! Input file names + character(len=200) :: tideamp_file ! Input file names or paths + character(len=80) :: tideamp_var, rough_var, TKE_input_var ! Input file variable names + real :: hamp ! The magnitude of the sub-gridscale bottom depth variance [Z ~> m] + real :: utide ! The RMS tidal amplitude [Z T-1 ~> m s-1] + real :: max_frac_rough ! A limit on the depth variance as a fraction of the total depth [nondim] + real :: prandtl_tidal ! Prandtl number used by CVMix tidal mixing schemes to convert vertical + ! diffusivities into viscosities [nondim] + real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data [nondim] integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed @@ -442,8 +449,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & "The decay scale away from the bottom for tidal TKE with "//& "the new coding when INT_TIDE_DISSIPATION is used.", & - !units="m", default=0.0) - units="m", default=500.0, scale=US%m_to_Z) ! TODO: confirm this new default + units="m", default=500.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with "//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) @@ -496,7 +502,13 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) - call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) + call get_param(param_file, mdl, "TIDEAMP_VARNAME", tideamp_var, & + "The name of the tidal amplitude variable in the input file.", & + default="tideamp") + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(filename, tideamp_var, CS%tideamp, G%domain, & + rescale=US%m_to_Z*US%T_to_s) endif call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -505,7 +517,13 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di fail_if_missing=(.not.CS%use_CVMix_tidal)) filename = trim(CS%inputdir) // trim(h2_file) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) - call MOM_read_data(filename, 'h2', CS%h2, G%domain, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "ROUGHNESS_VARNAME", rough_var, & + "The name in the input file of the squared sub-grid-scale "//& + "topographic roughness amplitude variable.", default="h2") + ! NOTE: There are certain cases where FMS is unable to read this file, so + ! we use read_netCDF_data in place of MOM_read_data. + call read_netCDF_data(filename, rough_var, CS%h2, G%domain, & + rescale=US%m_to_Z**2) call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& @@ -536,30 +554,31 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di if (CS%Lee_wave_dissipation) then - call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & + call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE", Niku_TKE_input_file, & "The path to the file containing the TKE input from lee "//& "wave driven mixing. Used with LEE_WAVE_DISSIPATION.", & fail_if_missing=.true.) - call get_param(param_file, mdl, "NIKURASHIN_SCALE",Niku_scale, & + call get_param(param_file, mdl, "NIKURASHIN_SCALE", Niku_scale, & "A non-dimensional factor by which to scale the lee-wave "//& "driven TKE input. Used with LEE_WAVE_DISSIPATION.", & units="nondim", default=1.0) filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) - call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & - filename) + call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", filename) + call get_param(param_file, mdl, "TKE_INPUT_VAR", TKE_input_var, & + "The name in the input file of the turbulent kinetic energy input variable.", & + default="TKE_input") allocate(CS%TKE_Niku(is:ie,js:je), source=0.) - call MOM_read_data(filename, 'TKE_input', CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja + + call MOM_read_data(filename, TKE_input_var, CS%TKE_Niku, G%domain, timelevel=1, & ! ??? timelevel -aja scale=Niku_scale*US%W_m2_to_RZ3_T3) call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & "The fraction of the lee wave energy that is dissipated "//& - "locally with LEE_WAVE_DISSIPATION.", units="nondim", & - default=0.3333) + "locally with LEE_WAVE_DISSIPATION.", units="nondim", default=0.3333) call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & - "Scaling for the vertical decay scaleof the local "//& - "dissipation of lee waves dissipation.", units="nondim", & - default=1.0) + "Scaling for the vertical decay scale of the local "//& + "dissipation of lee wave dissipation.", units="nondim", default=1.0) else CS%Decay_scale_factor_lee = -9.e99 ! This should never be used if CS%Lee_wave_dissipation = False endif @@ -571,25 +590,19 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di !call openParameterBlock(param_file,'CVMix_TIDAL') call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & - units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMix, 100e-4 in POP. + units="m^2/s", default=50e-4, scale=US%m2_s_to_Z2_T) ! the default is 50e-4 in CVMix, 100e-4 in POP. call get_param(param_file, mdl, "TIDAL_DISS_LIM_TC", CS%tidal_diss_lim_tc, & "Min allowable depth for dissipation for tidal-energy-constituent data. "//& "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & units="m", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & - "The path to the file containing tidal energy "//& - "dissipation. Used with CVMix tidal mixing schemes.", & - fail_if_missing=.true.) - call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & - do_not_log=.True.) + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & + units="m", default=0.001, scale=US%m_to_Z, do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & "Prandtl number used by CVMix tidal mixing schemes "//& "to convert vertical diffusivities into viscosities.", & - units="nondim", default=1.0, & - do_not_log=.true.) - call CVMix_put(CS%CVMix_glb_params,'Prandtl',prandtl_tidal) + units="nondim", default=1.0, do_not_log=.true.) + call CVMix_put(CS%CVMix_glb_params, 'Prandtl', prandtl_tidal) - tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & "The type of input tidal energy flux dataset. Valid values are"//& "\t Jayne\n"//& @@ -610,11 +623,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di mix_scheme = CVMix_tidal_scheme_str, & efficiency = CS%Mu_itides, & vertical_decay_scale = CS%int_tide_decay_scale*US%Z_to_m, & - max_coefficient = CS%tidal_max_coef, & + max_coefficient = CS%tidal_max_coef*US%Z2_T_to_m2_s, & local_mixing_frac = CS%Gamma_itides, & depth_cutoff = CS%min_zbot_itides*US%Z_to_m) - call read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) + call read_tidal_energy(G, US, tidal_energy_type, param_file, CS) !call closeParameterBlock(param_file) @@ -639,11 +652,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, & - 'input tidal energy dissipated locally interpolated to model vertical coordinates', '') + 'input tidal energy dissipated locally interpolated to model vertical coordinates', & + 'W m-2', conversion=US%RZ3_T3_to_W_m2) endif CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') - else CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & 'Internal Tide Driven Turbulent Kinetic Energy', & @@ -772,19 +785,26 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! Local variables real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] - real, dimension(SZK_(GV)+1) :: vert_dep ! vertical deposition + real, dimension(SZK_(GV)+1) :: vert_dep ! vertical deposition [nondim] real, dimension(SZK_(GV)+1) :: iFaceHeight ! Height of interfaces [m] - real, dimension(SZK_(GV)+1) :: SchmittnerSocn + real, dimension(SZK_(GV)+1) :: SchmittnerSocn ! A larger value of the Schmittner coefficint to + ! use in the Southern Ocean [nondim]. If this is smaller + ! than Schmittner_coeff, that standard value is used. real, dimension(SZK_(GV)) :: cellHeight ! Height of cell centers [m] real, dimension(SZK_(GV)) :: tidal_qe_md ! Tidal dissipation energy interpolated from 3d input - ! to model coordinates + ! to model coordinates [R Z3 T-3 ~> W m-2] real, dimension(SZK_(GV)+1) :: N2_int_i ! De-scaled interface buoyancy frequency [s-2] - real, dimension(SZK_(GV)) :: Schmittner_coeff + real, dimension(SZK_(GV)) :: Schmittner_coeff ! A coefficient in the Schmittner et al (2014) mixing + ! parameterization [nondim] real, dimension(SZK_(GV)) :: h_m ! Cell thickness [m] - real, allocatable, dimension(:,:) :: exp_hab_zetar + real, allocatable, dimension(:,:) :: exp_hab_zetar ! A badly documented array that appears to be + ! related to the distribution of tidal mixing energy, with unusual array + ! extents that are not explained, that is set and used by the CVMix + ! tidal mixing schemes, perhaps in [m3 kg-1]? + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] + real :: Simmons_coeff ! A coefficient in the Simmons et al (2004) mixing parameterization [nondim] integer :: i, k, is, ie - real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg m-3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) @@ -798,18 +818,18 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 + ! Compute cell center depth and cell bottom in meters (negative values in the ocean) do k=1,GV%ke - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment, rescaled to m for use by CVMix. + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo call CVMix_compute_Simmons_invariant( nlev = GV%ke, & - energy_flux = CS%tidal_qe_2d(i,j), & + energy_flux = US%RZ3_T3_to_W_m2*CS%tidal_qe_2d(i,j), & rho = rho_fw, & SimmonsCoeff = Simmons_coeff, & VertDep = vert_dep, & @@ -859,7 +879,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! diagnostics if (allocated(CS%dd%Kd_itidal)) then - CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T * Kd_tidal(:) endif if (allocated(CS%dd%N2_int)) then CS%dd%N2_int(i,j,:) = N2_int(i,:) @@ -884,16 +904,17 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int if (G%mask2dT(i,j)<1) cycle - iFaceHeight = 0.0 ! BBL is all relative to the surface + iFaceHeight(:) = 0.0 ! BBL is all relative to the surface hcorr = 0.0 + ! Compute heights at cell center and interfaces, and rescale layer thicknesses do k=1,GV%ke h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h_m(k) + hcorr ! Nominal thickness less the accumulated error (could temporarily make dh<0) + dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh + dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh + iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh enddo SchmittnerSocn = 0.0 ! TODO: compute this @@ -911,14 +932,14 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! CVMix API to prevent this redundancy. ! remap from input z coordinate to model coordinate: - tidal_qe_md = 0.0 + tidal_qe_md(:) = 0.0 call remapping_core_h(CS%remap_cs, size(CS%h_src), CS%h_src, CS%tidal_qe_3d_in(i,j,:), & GV%ke, h_m, tidal_qe_md, GV%H_subroundoff, GV%H_subroundoff) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. call CVMix_compute_SchmittnerCoeff( nlev = GV%ke, & - energy_flux = tidal_qe_md(:), & + energy_flux = US%RZ3_T3_to_W_m2*tidal_qe_md(:), & SchmittnerCoeff = Schmittner_coeff, & exp_hab_zetar = exp_hab_zetar, & CVmix_tidal_params_user = CS%CVMix_tidal_params) @@ -1572,29 +1593,42 @@ end subroutine tidal_mixing_h_amp ! TODO: move this subroutine to MOM_internal_tide_input module (?) !> This subroutine read tidal energy inputs from a file. -subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) +subroutine read_tidal_energy(G, US, tidal_energy_type, param_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=20), intent(in) :: tidal_energy_type !< The type of tidal energy inputs to read - character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidalinputs + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module - ! local + + ! local variables + character(len=200) :: tidal_energy_file ! Input file names or paths + character(len=200) :: tidal_input_var ! Input file variable name + character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. integer :: i, j, isd, ied, jsd, jed - real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points [W m-2] + real, allocatable, dimension(:,:) :: & + tidal_energy_flux_2d ! Input tidal energy flux at T-grid points [R Z3 T-3 ~> W m-2] isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + call get_param(param_file, mdl, "TIDAL_ENERGY_FILE", tidal_energy_file, & + "The path to the file containing tidal energy dissipation. "//& + "Used with CVMix tidal mixing schemes.", fail_if_missing=.true.) + tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) + select case (uppercase(tidal_energy_type(1:4))) case ('JAYN') ! Jayne 2009 if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) - call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) + call get_param(param_file, mdl, "TIDAL_DISSIPATION_VAR", tidal_input_var, & + "The name in the input file of the tidal energy source for mixing.", & + default="wave_dissipation") + call MOM_read_data(tidal_energy_file, tidal_input_var, tidal_energy_flux_2d, G%domain, scale=US%W_m2_to_RZ3_T3) do j=G%jsc,G%jec ; do i=G%isc,G%iec CS%tidal_qe_2d(i,j) = CS%Gamma_itides * tidal_energy_flux_2d(i,j) enddo ; enddo deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 - call read_tidal_constituents(G, US, tidal_energy_file, CS) + call read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") end select @@ -1602,25 +1636,26 @@ subroutine read_tidal_energy(G, US, tidal_energy_type, tidal_energy_file, CS) end subroutine read_tidal_energy !> This subroutine reads tidal input energy from a file by constituent. -subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) +subroutine read_tidal_constituents(G, US, tidal_energy_file, param_file, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=200), intent(in) :: tidal_energy_file !< The file from which to read tidal energy inputs + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module ! local variables - real, parameter :: C1_3 = 1.0/3.0 + real, parameter :: C1_3 = 1.0/3.0 ! A rational constant [nondim] real, dimension(SZI_(G),SZJ_(G)) :: & - tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert - tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert + tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert [nondim] + tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert [nondim] real, allocatable, dimension(:) :: & z_t, & ! depth from surface to midpoint of input layer [Z ~> m] z_w ! depth from surface to top of input layer [Z ~> m] real, allocatable, dimension(:,:,:) :: & - tc_m2, & ! input lunar semidiurnal tidal energy flux [W m-2] - tc_s2, & ! input solar semidiurnal tidal energy flux [W m-2] - tc_k1, & ! input lunar diurnal tidal energy flux [W m-2] - tc_o1 ! input lunar diurnal tidal energy flux [W m-2] + tc_m2, & ! input lunar semidiurnal tidal energy flux [R Z3 T-3 ~> W m-2] + tc_s2, & ! input solar semidiurnal tidal energy flux [R Z3 T-3 ~> W m-2] + tc_k1, & ! input lunar diurnal tidal energy flux [R Z3 T-3 ~> W m-2] + tc_o1 ! input lunar diurnal tidal energy flux [R Z3 T-3 ~> W m-2] integer, dimension(4) :: nz_in integer :: k, is, ie, js, je, isd, ied, jsd, jed, i, j @@ -1642,13 +1677,13 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz_in(1))) ! read in tidal constituents - call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) - call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) - call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) - call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain) + call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain, scale=US%W_m2_to_RZ3_T3) + call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain, scale=US%W_m2_to_RZ3_T3) + call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain, scale=US%W_m2_to_RZ3_T3) + call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain, scale=US%W_m2_to_RZ3_T3) ! Note the hard-coded assumption that z_t and z_w in the file are in centimeters. - call MOM_read_data(tidal_energy_file, 'z_t', z_t, scale=100.0*US%m_to_Z) - call MOM_read_data(tidal_energy_file, 'z_w', z_w, scale=100.0*US%m_to_Z) + call MOM_read_data(tidal_energy_file, 'z_t', z_t, scale=0.01*US%m_to_Z) + call MOM_read_data(tidal_energy_file, 'z_w', z_w, scale=0.01*US%m_to_Z) do j=js,je ; do i=is,ie if (abs(G%geoLatT(i,j)) < 30.0) then diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index dff879d83e..ea6c7f112b 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -7,12 +7,15 @@ module MOM_vert_friction use MOM_diag_mediator, only : post_product_u, post_product_sum_u use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : To_North, To_East use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : mech_forcing use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_io, only : MOM_read_data, slasher use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init @@ -24,6 +27,7 @@ module MOM_vert_friction use MOM_variables, only : ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS +use MOM_lateral_mixing_coeffs, only : VarMix_CS implicit none ; private #include @@ -49,10 +53,24 @@ module MOM_vert_friction !! from the surface; this can get very large with thin layers. real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. + real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [H ~> m or kg m-2]. real :: Kv_extra_bbl !< An extra vertical viscosity in the bottom boundary layer of thickness !! Hbbl when there is not a bottom drag law in use [Z2 T-1 ~> m2 s-1]. - real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] - + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] + + logical :: use_GL90_in_SSW !< If true, use the GL90 parameterization in stacked shallow water mode (SSW). + !! The calculation of the GL90 viscosity coefficient uses the fact that in SSW + !! we simply have 1/N^2 = h/g^prime, where g^prime is the reduced gravity. + !! This identity does not generalize to non-SSW setups. + logical :: use_GL90_N2 !< If true, use GL90 vertical viscosity coefficient that is depth-independent; + !! this corresponds to a kappa_GM that scales as N^2 with depth. + real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme + !! [L2 T-1 ~> m2 s-1] + logical :: read_kappa_gl90 !< If true, read a file containing the spatially varying kappa_gl90 + real :: alpha_gl90 !< Coefficient used to compute a depth-independent GL90 vertical + !! viscosity via Kv_gl90 = alpha_gl90 * f^2. Note that the implied + !! Kv_gl90 corresponds to a kappa_gl90 that scales as N^2 with depth. + !! [L2 T ~> m2 s] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -66,17 +84,21 @@ module MOM_vert_friction !! will often equal CFL_trunc. real :: truncRampTime !< The time-scale over which to ramp up the value of !! CFL_trunc from CFL_truncS to CFL_truncE [T ~> s] - real :: CFL_truncS !< The start value of CFL_trunc - real :: CFL_truncE !< The end/target value of CFL_trunc + real :: CFL_truncS !< The start value of CFL_trunc [nondim] + real :: CFL_truncE !< The end/target value of CFL_trunc [nondim] logical :: CFLrampingIsActivated = .false. !< True if the ramping has been initialized type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-1]. + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & + a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-1]. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & + a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under @@ -133,13 +155,17 @@ module MOM_vert_friction type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. + real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 T-1 ~> m2 s-1] !>@{ 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_visc = -1, id_dv_dt_visc = -1, id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1 + integer :: id_GLwork = -1 + integer :: id_au_vv = -1, id_av_vv = -1, id_au_gl90_vv = -1, id_av_gl90_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 + integer :: id_Kv_gl90_u = -1, id_Kv_gl90_v = -1 ! integer :: id_hf_du_dt_visc = -1, id_hf_dv_dt_visc = -1 integer :: id_h_du_dt_visc = -1, id_h_dv_dt_visc = -1 integer :: id_hf_du_dt_visc_2d = -1, id_hf_dv_dt_visc_2d = -1 @@ -150,10 +176,124 @@ module MOM_vert_friction type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() !< A pointer to the control structure !! for recording accelerations leading to velocity truncations + type(group_pass_type) :: pass_KE_uv !< A handle used for group halo passes end type vertvisc_CS contains +!> Compute coupling coefficient associated with vertical viscosity parameterization as in Greatbatch and Lamb +!! (1990), hereafter referred to as the GL90 vertical viscosity parameterization. This vertical viscosity scheme +!! redistributes momentum in the vertical, and is the equivalent of the Gent & McWilliams (1990) parameterization, +!! but in a TWA (thickness-weighted averaged) set of equations. The vertical viscosity coefficient nu is computed +!! from kappa_GM via thermal wind balance, and the following relation: +!! nu = kappa_GM * f^2 / N^2. +!! In the following subroutine kappa_GM is assumed either (a) constant or (b) horizontally varying. In both cases, +!! (a) and (b), one can additionally impose an EBT structure in the vertical for kappa_GM. +!! A third possible formulation of nu is depth-independent: +!! nu = f^2 * alpha +!! The latter formulation would be equivalent to a kappa_GM that varies as N^2 with depth. +!! The vertical viscosity del_z ( nu del_z u) is applied to the momentum equation with stress-free boundary +!! conditions at the top and bottom. +!! +!! In SSW mode, we have 1/N^2 = h/g'. The coupling coefficient is therefore equal to +!! a_cpl_gl90 = nu / h = kappa_GM * f^2 / g' +!! or +!! a_cpl_gl90 = nu / h = f^2 * alpha / h + +subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u) + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity + !! grid point [H ~> m or kg m-2]. + logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient + !! for a column + real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the + !! bottom, normalized by the GL90 bottom + !! boundary layer thickness [nondim] + real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated + !! with GL90 across interfaces; is not + !! included in a_cpl [Z T-1 ~> m s-1]. + integer, intent(in) :: j !< j-index to find coupling coefficient for + type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients + logical, intent(in) :: work_on_u !< If true, u-points are being calculated, + !! otherwise they are v-points. + + ! local variables + logical :: kdgl90_use_ebt_struct + integer :: i, k, is, ie, nz, Isq, Ieq + real :: f2 !< Squared Coriolis parameter at a + !! velocity grid point [T-2 ~> s-2]. + real :: h_neglect ! A thickness that is so small + !! it is usually lost in roundoff error + !! and can be neglected [H ~> m or kg m-2]. + real :: botfn ! A function that is 1 at the bottom + !! and small far from it [nondim] + real :: z2 ! The distance from the bottom, + !! normalized by Hbbl_gl90 [nondim] + + is = G%isc ; ie = G%iec + Isq = G%IscB ; Ieq = G%IecB + nz = GV%ke + + h_neglect = GV%H_subroundoff + kdgl90_use_ebt_struct = .false. + if (VarMix%use_variable_mixing) then + kdgl90_use_ebt_struct = VarMix%kdgl90_use_ebt_struct + endif + + if (work_on_u) then + ! compute coupling coefficient at u-points + do I=Isq,Ieq; if (do_i(I)) then + f2 = 0.25 * (G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J))**2 + do K=2,nz + if (CS%use_GL90_N2) then + a_cpl_gl90(I,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(I,k) + hvel(I,k-1) + h_neglect) + else + if (CS%read_kappa_gl90) then + a_cpl_gl90(I,K) = f2 * 0.5 * (CS%kappa_gl90_2d(i,j) + CS%kappa_gl90_2d(i+1,j)) / GV%g_prime(K) + else + a_cpl_gl90(I,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + endif + if (kdgl90_use_ebt_struct) then + a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + endif + endif + ! botfn determines when a point is within the influence of the GL90 bottom boundary layer, + ! going from 1 at the bottom to 0 in the interior. + z2 = z_i(I,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + a_cpl_gl90(I,K) = a_cpl_gl90(I,K) * (1 - botfn) + enddo + endif; enddo + else + ! compute viscosities at v-points + do i=is,ie; if (do_i(i)) then + f2 = 0.25 * (G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J))**2 + do K=2,nz + if (CS%use_GL90_N2) then + a_cpl_gl90(i,K) = 2.0 * f2 * CS%alpha_gl90 / (hvel(i,k) + hvel(i,k-1) + h_neglect) + else + if (CS%read_kappa_gl90) then + a_cpl_gl90(i,K) = f2 * 0.5 * (CS%kappa_gl90_2d(i,j) + CS%kappa_gl90_2d(i,j+1)) / GV%g_prime(K) + else + a_cpl_gl90(i,K) = f2 * CS%kappa_gl90 / GV%g_prime(K) + endif + if (kdgl90_use_ebt_struct) then + a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + endif + endif + ! botfn determines when a point is within the influence of the GL90 bottom boundary layer, + ! going from 1 at the bottom to 0 in the interior. + z2 = z_i(i,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + a_cpl_gl90(i,K) = a_cpl_gl90(i,K) * (1 - botfn) + enddo + endif; enddo + endif + +end subroutine find_coupling_coef_gl90 + !> Perform a fully implicit vertical diffusion !! of momentum. Stress top and bottom boundary conditions are used. !! @@ -222,9 +362,16 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! 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 :: zDS, h_a ! Temporary thickness variables used with direct_stress [H ~> m or kg m-2] + real :: hfr ! Temporary ratio of thicknesses used with direct_stress [nondim] 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]. + real, allocatable, dimension(:,:,:) :: KE_term ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real, allocatable, dimension(:,:,:) :: KE_u ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real, allocatable, dimension(:,:,:) :: KE_v ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] logical :: do_i(SZIB_(G)) logical :: DoStokesMixing @@ -239,6 +386,14 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") + if (CS%id_GLwork > 0) then + allocate(KE_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + allocate(KE_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + allocate(KE_term(G%isd:G%ied,G%jsd:G%jed,GV%ke), source=0.0) + if (.not.G%symmetric) & + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) + endif + if (CS%direct_stress) then Hmix = CS%Hmix_stress I_Hmix = 1.0 / Hmix @@ -278,7 +433,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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) enddo ; enddo ; endif - + if (associated(ADp%du_dt_visc_gl90)) then ; do k=1,nz ; do I=Isq,Ieq + ADp%du_dt_visc_gl90(I,j,k) = u(I,j,k) + enddo ; enddo ; endif 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 @@ -367,6 +524,46 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo endif + ! compute vertical velocity tendency that arises from GL90 viscosity; + ! follow tridiagonal solve method as above; to avoid corrupting u, + ! use ADp%du_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + if (associated(ADp%du_dt_visc_gl90)) then + do I=Isq,Ieq ; if (do_i(I)) then + b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1)) + endif ; enddo + do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then + c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1)) + d1(I) = b_denom_1 * b1(I) + ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & + dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) + endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90 + do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + ADp%du_dt_visc_gl90(I,j,k) = ADp%du_dt_visc_gl90(I,j,k) + c1(I,k+1) * ADp%du_dt_visc_gl90(I,j,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) then + ! now fill ADp%du_dt_visc_gl90(I,j,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + ! and ADp%du_dt_visc_gl90(I,j,k) the updated velocity due to GL90 + ADp%du_dt_visc_gl90(I,j,k) = (ADp%du_dt_visc_gl90(I,j,k) - ADp%du_dt_visc(I,j,k))*Idt + if (abs(ADp%du_dt_visc_gl90(I,j,k)) < accel_underflow) ADp%du_dt_visc_gl90(I,j,k) = 0.0 + endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by u*h, where u is original velocity before + ! velocity update; note that ADp%du_dt_visc(I,j,k) holds the original velocity value u(I,j,k) + if (CS%id_GLwork > 0) then + do k=1,nz; do I=Isq,Ieq ; if (do_i(I)) then + KE_u(I,j,k) = ADp%du_dt_visc(I,j,k) * CS%h_u(I,j,k) * G%areaCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) + endif ; enddo ; enddo + endif + endif + 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 @@ -408,7 +605,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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) enddo ; enddo ; endif - + if (associated(ADp%dv_dt_visc_gl90)) then ; do k=1,nz ; do i=is,ie + ADp%dv_dt_visc_gl90(i,J,k) = v(i,J,k) + enddo ; enddo ; endif 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 @@ -467,6 +666,47 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ; enddo ; enddo endif + ! compute vertical velocity tendency that arises from GL90 viscosity; + ! follow tridiagonal solve method as above; to avoid corrupting v, + ! use ADp%dv_dt_visc_gl90 as a placeholder for updated u (due to GL90) until last do loop + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + if (associated(ADp%dv_dt_visc_gl90)) then + do i=is,ie ; if (do_i(i)) then + b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1)) + endif ; enddo + do k=2,nz ; do i=is,ie ; if (do_i(i)) then + c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1)) + d1(i) = b_denom_1 * b1(i) + ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & + dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) + endif ; enddo ; enddo + ! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90 + do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then + ADp%dv_dt_visc_gl90(i,J,k) = ADp%dv_dt_visc_gl90(i,J,k) + c1(i,k+1) * ADp%dv_dt_visc_gl90(i,J,k+1) + endif ; enddo ; enddo ! i and k loops + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! now fill ADp%dv_dt_visc_gl90(i,J,k) with actual velocity tendency due to GL90; + ! note that on RHS: ADp%dv_dt_visc(i,J,k) holds the original velocity value v(i,J,k) + ! and ADp%dv_dt_visc_gl90(i,J,k) the updated velocity due to GL90 + ADp%dv_dt_visc_gl90(i,J,k) = (ADp%dv_dt_visc_gl90(i,J,k) - ADp%dv_dt_visc(i,J,k))*Idt + if (abs(ADp%dv_dt_visc_gl90(i,J,k)) < accel_underflow) ADp%dv_dt_visc_gl90(i,J,k) = 0.0 + endif ; enddo ; enddo ; + ! to compute energetics, we need to multiply by v*h, where u is original velocity before + ! velocity update; note that ADp%dv_dt_visc(I,j,k) holds the original velocity value v(i,J,k) + if (CS%id_GLwork > 0) then + do k=1,nz ; do i=is,ie ; if (do_i(i)) then + ! note that on RHS: ADp%dv_dt_visc(I,j,k) holds the original velocity value v(I,j,k) + KE_v(I,j,k) = ADp%dv_dt_visc(i,J,k) * CS%h_v(i,J,k) * G%areaCv(i,J) * ADp%dv_dt_visc_gl90(i,J,k) + endif ; enddo ; enddo + endif + endif + 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 @@ -492,6 +732,23 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ! end of v-component J loop + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + ! We do the KE-rate calculation here (rather than in MOM_diagnostics) to ensure + ! a sign-definite term. MOM_diagnostics does not have access to the velocities + ! and thicknesses used in the vertical solver, but rather uses a time-mean + ! barotropic transport [uv]h. + if (CS%id_GLwork > 0) then + if (.not.G%symmetric) & + call do_group_pass(CS%pass_KE_uv, G%domain) + do k=1,nz + do j=js,je ; do i=is,ie + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & + * (KE_u(I,j,k) + KE_u(I-1,j,k) + KE_v(i,J,k) + KE_v(i,J-1,k)) + enddo ; enddo + enddo + call post_data(CS%id_GLwork, KE_term, CS%diag) + endif + call vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS) ! Here the velocities associated with open boundary conditions are applied. @@ -517,8 +774,12 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (query_averaging_enabled(CS%diag)) then if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) + if (CS%id_du_dt_visc_gl90 > 0) & + call post_data(CS%id_du_dt_visc_gl90, ADp%du_dt_visc_gl90, CS%diag) if (CS%id_dv_dt_visc > 0) & call post_data(CS%id_dv_dt_visc, ADp%dv_dt_visc, CS%diag) + if (CS%id_dv_dt_visc_gl90 > 0) & + call post_data(CS%id_dv_dt_visc_gl90, ADp%dv_dt_visc_gl90, CS%diag) if (present(taux_bot) .and. (CS%id_taux_bot > 0)) & call post_data(CS%id_taux_bot, taux_bot, CS%diag) if (present(tauy_bot) .and. (CS%id_tauy_bot > 0)) & @@ -671,10 +932,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) end subroutine vertvisc_remnant -!> Calculate the coupling coefficients (CS%a_u and CS%a_v) +!> Calculate the coupling coefficients (CS%a_u, CS%a_v, CS%a_u_gl90, CS%a_v_gl90) !! and effective layer thicknesses (CS%h_u and CS%h_v) for later use in the !! applying the implicit vertical viscosity via vertvisc(). -subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) +subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC, VarMix) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -689,7 +950,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure - + type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients ! Field from forces used in this subroutine: ! ustar: the friction velocity [Z T-1 ~> m s-1], used here as the mixing ! velocity in the mixed layer if NKML > 1 in a bulk mixed layer. @@ -706,17 +967,24 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, dimension(SZIB_(G),SZK_(GV)+1) :: & a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times ! the velocity difference gives the stress across an interface. + a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1]. + ! a_cpl_gl90 times the velocity difference gives the GL90 stress across an interface. + ! a_cpl_gl90 is part of a_cpl. a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. - z_i ! An estimate of each interface's height above the bottom, + z_i, & ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness [nondim] + z_i_gl90 ! An estimate of each interface's height above the bottom, + ! normalized by the GL90 bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. + I_Hbbl_gl90, &! The inverse of the bottom boundary layer thickness used for the GL90 scheme + ! [H-1 ~> m-1 or m2 kg-1]. I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. - zcol1, & ! The height of the interfaces to the north and south of a - zcol2, & ! v-point [H ~> m or kg m-2]. + zcol1, & ! The height of the interfaces to the south of a v-point [H ~> m or kg m-2]. + zcol2, & ! The height of the interfaces to the north of a v-point [H ~> m or kg m-2]. Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2]. Dmin, & ! The shallower of the two adjacent bottom depths converted to ! thickness units [H ~> m or kg m-2]. @@ -727,6 +995,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior [nondim]. @@ -761,12 +1031,19 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) h_neglect = GV%H_subroundoff a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) + if (CS%use_GL90_in_SSW) then + I_Hbbl_gl90 = 1.0 / (CS%Hbbl_gl90 + h_neglect) + endif 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) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) if (CS%id_Kv_v > 0) allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + if (CS%id_Kv_gl90_u > 0) allocate(Kv_gl90_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + + if (CS%id_Kv_gl90_v > 0) allocate(Kv_gl90_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) + 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) @@ -864,6 +1141,23 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) + a_cpl_gl90(:,:) = 0.0 + if (CS%use_GL90_in_SSW) then + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that + ! no momentum gets fluxed into vanished layers. The scheme is not + ! sensitive to the exact value of Hbbl_gl90, as long as it is in a + ! reasonable range (~1-20 m): large enough to capture vanished layers + ! over topography, small enough to not contaminate the interior. + do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo + do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then + z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I) + endif ; enddo ; enddo ! i & k loops + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) + endif + if (allocated(hML_u)) then do i=isq,ieq ; if (do_i(i)) then ; hML_u(I,j) = h_ml(I) ; endif ; enddo endif @@ -913,13 +1207,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i_shelf(I)) then - CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * a_shelf(I,K) + & - (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) + CS%a_u(I,j,K) = min(a_cpl_max, (forces%frac_shelf_u(I,j) * a_shelf(I,K) + & + (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) + a_cpl_gl90(I,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_u(I,j,K) = min(a_cpl_max, forces%frac_shelf_u(I,j) * max(a_shelf(I,K), a_cpl(I,K)) + & ! (1.0-forces%frac_shelf_u(I,j)) * a_cpl(I,K)) elseif (do_i(I)) then - CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) endif ; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i_shelf(I)) then ! Should we instead take the inverse of the average of the inverses? @@ -929,7 +1224,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) CS%h_u(I,j,k) = hvel(I,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K)) ; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) + endif; enddo ; enddo + do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) + endif; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo endif @@ -939,7 +1239,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif - + ! Diagnose GL90 Kv at u-points + if (CS%id_Kv_gl90_u > 0) then + do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) + enddo ; enddo + endif enddo @@ -1031,6 +1336,25 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) + a_cpl_gl90(:,:) = 0.0 + if (CS%use_GL90_in_SSW) then + ! The following block calculates the normalized height above the GL90 + ! BBL (z_i_gl90), using a harmonic mean between layer thicknesses. For the + ! GL90 BBL we use simply a constant (Hbbl_gl90). The purpose is that the GL90 + ! coupling coefficient is zeroed out within Hbbl_gl90, to ensure that + ! no momentum gets fluxed into vanished layers. The scheme is not + ! sensitive to the exact value of Hbbl_gl90, as long as it is in a + ! reasonable range (~1-20 m): large enough to capture vanished layers + ! over topography, small enough to not contaminate the interior. + do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo + + do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then + z_i_gl90(i,k) = z_i_gl90(i,k+1) + h_harm(i,k)*I_Hbbl_gl90(i) + endif ; enddo ; enddo ! i & k loops + + call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) + endif + if ( allocated(hML_v)) then do i=is,ie ; if (do_i(i)) then ; hML_v(i,J) = h_ml(i) ; endif ; enddo endif @@ -1079,13 +1403,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (do_any_shelf) then do K=1,nz+1 ; do i=is,ie ; if (do_i_shelf(i)) then - CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * a_shelf(i,k) + & - (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) + CS%a_v(i,J,K) = min(a_cpl_max, (forces%frac_shelf_v(i,J) * a_shelf(i,k) + & + (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) + a_cpl_gl90(i,K)) ! This is Alistair's suggestion, but it destabilizes the model. I do not know why. RWH ! CS%a_v(i,J,K) = min(a_cpl_max, forces%frac_shelf_v(i,J) * max(a_shelf(i,K), a_cpl(i,K)) + & ! (1.0-forces%frac_shelf_v(i,J)) * a_cpl(i,K)) elseif (do_i(i)) then - CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) + CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) + CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i_shelf(i)) then ! Should we instead take the inverse of the average of the inverses? @@ -1095,7 +1420,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) CS%h_v(i,J,k) = hvel(i,k) + h_neglect endif ; enddo ; enddo else - do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K)) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then + CS%a_v(i,J,K) = min(a_cpl_max, a_cpl(i,K) + a_cpl_gl90(i,K)) + endif ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then + CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) + endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo endif @@ -1105,7 +1435,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif - + ! Diagnose GL90 Kv at v-points + if (CS%id_Kv_gl90_v > 0) then + do k=1,nz ; do i=is,ie + if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) + enddo ; enddo + endif enddo ! end of v-point j loop if (CS%debug) then @@ -1124,8 +1459,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) + if (CS%id_Kv_gl90_u > 0) call post_data(CS%id_Kv_gl90_u, Kv_gl90_u, CS%diag) + if (CS%id_Kv_gl90_v > 0) call post_data(CS%id_Kv_gl90_v, Kv_gl90_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) + if (CS%id_au_gl90_vv > 0) call post_data(CS%id_au_gl90_vv, CS%a_u_gl90, CS%diag) + if (CS%id_av_gl90_vv > 0) call post_data(CS%id_av_gl90_vv, CS%a_v_gl90, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) if (CS%id_h_v > 0) call post_data(CS%id_h_v, CS%h_v, CS%diag) if (CS%id_hML_u > 0) call post_data(CS%id_hML_u, hML_u, CS%diag) @@ -1182,7 +1521,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, z_t, & ! The distance from the top, sometimes normalized ! by Hmix, [H ~> m or kg m-2] or [nondim]. kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. - tbl_thick + tbl_thick ! The thickness of the top boundary layer [H ~> m or kg m-2] real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. @@ -1583,8 +1922,8 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS ! Local variables - real :: maxvel ! Velocities components greater than maxvel - real :: truncvel ! are truncated to truncvel, both [L T-1 ~> m s-1]. + real :: maxvel ! Velocities components greater than maxvel are truncated [L T-1 ~> m s-1] + real :: truncvel ! The speed to which velocity components greater than maxvel are set [L T-1 ~> m s-1] real :: CFL ! The local CFL number [nondim] real :: H_report ! A thickness below which not to report truncations [H ~> m or kg m-2] real :: vel_report(SZIB_(G),SZJB_(G)) ! The velocity to report [L T-1 ~> m s-1] @@ -1790,7 +2129,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Local variables real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [Z2 T-1 ~> m2 s-1]. - real :: Hmix_m ! A boundary layer thickness [m]. + real :: Hmix_z ! A boundary layer thickness [Z ~> m]. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the @@ -1798,6 +2137,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & !! use an arbitrary and hard-coded maximum viscous coupling coefficient !! between layers. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + character(len=200) :: kappa_gl90_file, inputdir, kdgl90_varname ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. @@ -1894,17 +2234,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & default=0.0, units="nondim") call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) - if (GV%nkml < 1) & - call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface "//& - "viscosity and diffusivity are elevated when the bulk "//& - "mixed layer is not used.", units="m", scale=GV%m_to_H, & - unscaled=Hmix_m, fail_if_missing=.true.) + if (GV%nkml < 1) then + call get_param(param_file, mdl, "HMIX_FIXED", Hmix_z, & + "The prescribed depth over which the near-surface viscosity and "//& + "diffusivity are elevated when the bulk mixed layer is not used.", & + units="m", scale=US%m_to_Z, fail_if_missing=.true.) + CS%Hmix = GV%Z_to_H * Hmix_z + endif if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & - units="m", default=Hmix_m, scale=GV%m_to_H) + units="m", default=US%Z_to_m*Hmix_z, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & @@ -1917,6 +2258,68 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T) + call get_param(param_file, mdl, "USE_GL90_IN_SSW", CS%use_GL90_in_SSW, & + "If true, use simpler method to calculate 1/N^2 in GL90 vertical "// & + "viscosity coefficient. This method is valid in stacked shallow water mode.", & + default=.false.) + call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & + "The scalar diffusivity used in GL90 vertical viscosity scheme.", & + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, & + do_not_log=.not.CS%use_GL90_in_SSW) + call get_param(param_file, mdl, "READ_KD_GL90", CS%read_kappa_gl90, & + "If true, read a file (given by KD_GL90_FILE) containing the "//& + "spatially varying diffusivity KD_GL90 used in the GL90 scheme.", default=.false., & + do_not_log=.not.CS%use_GL90_in_SSW) + if (CS%read_kappa_gl90) then + if (CS%kappa_gl90 > 0) then + call MOM_error(FATAL, "MOM_vert_friction.F90, vertvisc_init: KD_GL90 > 0 "// & + "is not compatible with READ_KD_GL90 = .TRUE. ") + endif + call get_param(param_file, mdl, "INPUTDIR", inputdir, & + "The directory in which all input files are found.", & + default=".", do_not_log=.true.) + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "KD_GL90_FILE", kappa_gl90_file, & + "The file containing the spatially varying diffusivity used in the "// & + "GL90 scheme.", default="kd_gl90.nc", do_not_log=.not.CS%use_GL90_in_SSW) + call get_param(param_file, mdl, "KD_GL90_VARIABLE", kdgl90_varname, & + "The name of the GL90 diffusivity variable to read "//& + "from KD_GL90_FILE.", default="kd_gl90", do_not_log=.not.CS%use_GL90_in_SSW) + kappa_gl90_file = trim(inputdir) // trim(kappa_gl90_file) + + allocate(CS%kappa_gl90_2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) + call MOM_read_data(kappa_gl90_file, kdgl90_varname, CS%kappa_gl90_2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call pass_var(CS%kappa_gl90_2d, G%domain) + endif + call get_param(param_file, mdl, "USE_GL90_N2", CS%use_GL90_N2, & + "If true, use GL90 vertical viscosity coefficient that is depth-independent; "// & + "this corresponds to a kappa_GM that scales as N^2 with depth.", & + default=.false., do_not_log=.not.CS%use_GL90_in_SSW) + if (CS%use_GL90_N2) then + if (.not. CS%use_GL90_in_SSW) call MOM_error(FATAL, & + "MOM_vert_friction.F90, vertvisc_init: "//& + "When USE_GL90_N2=True, USE_GL90_in_SSW must also be True.") + if (CS%kappa_gl90 > 0) then + call MOM_error(FATAL, "MOM_vert_friction.F90, vertvisc_init: KD_GL90 > 0 "// & + "is not compatible with USE_GL90_N2 = .TRUE. ") + endif + if (CS%read_kappa_gl90) call MOM_error(FATAL, & + "MOM_vert_friction.F90, vertvisc_init: "//& + "READ_KD_GL90 = .TRUE. is not compatible with USE_GL90_N2 = .TRUE.") + call get_param(param_file, mdl, "alpha_GL90", CS%alpha_gl90, & + "Coefficient used to compute a depth-independent GL90 vertical "//& + "viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// & + "if USE_GL90_N2 is true. Note that the implied Kv_GL90 "// & + "corresponds to a KD_GL90 that scales as N^2 with depth.", & + units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T, & + do_not_log=.not.CS%use_GL90_in_SSW) + endif + call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, & + "The thickness of the GL90 bottom boundary layer, "//& + "which defines the range over which the GL90 coupling "//& + "coefficient is zeroed out, in order to avoid fluxing "//& + "momentum into vanished layers over steep topography.", & + units="m", default=5.0, scale=GV%m_to_H, do_not_log=.not.CS%use_GL90_in_SSW) CS%Kvml_invZ2 = 0.0 if (GV%nkml < 1) then @@ -1936,14 +2339,14 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call MOM_error(WARNING, "KVML is a deprecated parameter. Use KV_ML_INVZ2 instead.") endif if (CS%Kvml_invZ2 < 0.0) CS%Kvml_invZ2 = 0.0 - call log_param(param_file, mdl, "KV_ML_INVZ2", US%Z2_T_to_m2_s*CS%Kvml_invZ2, & + call log_param(param_file, mdl, "KV_ML_INVZ2", CS%Kvml_invZ2, & "An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, "//& "with the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the "//& "distance from the surface, to allow for finite wind stresses to be "//& "transmitted through infinitesimally thin surface layers. This is an "//& "older option for numerical convenience without a strong physical basis, "//& "and its use is now discouraged.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s) endif if (.not.CS%bottomdraglaw) then @@ -1961,10 +2364,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%Kv_extra_bbl = Kv_BBL - CS%Kv endif endif - call log_param(param_file, mdl, "KV_EXTRA_BBL", US%Z2_T_to_m2_s*CS%Kv_extra_bbl, & + call log_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, & "An extra kinematic viscosity in the benthic boundary layer. "//& "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & - units="m2 s-1", default=0.0) + units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s) endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a viscosity increased by "//& @@ -2021,8 +2424,10 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "the age of the universe.", units="m s-1", default=0.0, scale=US%m_s_to_L_T) ALLOC_(CS%a_u(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u(:,:,:) = 0.0 + ALLOC_(CS%a_u_gl90(IsdB:IedB,jsd:jed,nz+1)) ; CS%a_u_gl90(:,:,:) = 0.0 ALLOC_(CS%h_u(IsdB:IedB,jsd:jed,nz)) ; CS%h_u(:,:,:) = 0.0 ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 + ALLOC_(CS%a_v_gl90(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v_gl90(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & @@ -2034,12 +2439,24 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + CS%id_Kv_gl90_u = register_diag_field('ocean_model', 'Kv_gl90_u', diag%axesCuL, Time, & + 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + + CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & + 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + CS%id_au_gl90_vv = register_diag_field('ocean_model', 'au_gl90_visc', diag%axesCui, Time, & + 'Zonal Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + + CS%id_av_gl90_vv = register_diag_field('ocean_model', 'av_gl90_visc', diag%axesCvi, Time, & + 'Meridional Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', & thickness_units, conversion=GV%H_to_MKS) @@ -2064,7 +2481,21 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 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_GLwork = register_diag_field('ocean_model', 'GLwork', diag%axesTL, Time, & + 'Sign-definite Kinetic Energy Source from GL90 Vertical Viscosity', & + 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) + CS%id_du_dt_visc_gl90 = register_diag_field('ocean_model', 'du_dt_visc_gl90', diag%axesCuL, Time, & + 'Zonal Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + if ((CS%id_du_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + call safe_alloc_ptr(ADp%du_dt_visc_gl90,IsdB,IedB,jsd,jed,nz) + call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) + endif + CS%id_dv_dt_visc_gl90 = register_diag_field('ocean_model', 'dv_dt_visc_gl90', diag%axesCvL, Time, & + 'Meridional Acceleration from GL90 Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + if ((CS%id_dv_dt_visc_gl90 > 0) .or. (CS%id_GLwork > 0)) then + call safe_alloc_ptr(ADp%dv_dt_visc_gl90,isd,ied,JsdB,JedB,nz) + call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) + endif 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) @@ -2218,6 +2649,7 @@ subroutine vertvisc_end(CS) DEALLOC_(CS%a_v) ; DEALLOC_(CS%h_v) if (associated(CS%a1_shelf_u)) deallocate(CS%a1_shelf_u) if (associated(CS%a1_shelf_v)) deallocate(CS%a1_shelf_v) + if (allocated(CS%kappa_gl90_2d)) deallocate(CS%kappa_gl90_2d) end subroutine vertvisc_end !> \namespace mom_vert_friction diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index d1c6ebd7bf..98788843e3 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -42,10 +42,18 @@ module DOME_tracer character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. 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 :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, perhaps in [g kg-1] + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out, perhaps in [g kg-1] logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. + real :: stripe_width !< The meridional width of the vertical stripes in the initial condition + !! for some of the DOME tracers, in [km] or [degrees_N] or [m]. + real :: stripe_s_lat !< The southern latitude of the first vertical stripe in the initial condition + !! for some of the DOME tracers, in [km] or [degrees_N] or [m]. + real :: sheet_spacing !< The vertical spacing between successive horizontal sheets of tracer in the initial + !! conditions for some of the DOME tracers [Z ~> m], and twice the thickness of + !! these horizontal tracer sheets + integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. @@ -58,14 +66,15 @@ module DOME_tracer contains !> Register tracer fields and subroutines to be used with MOM. -function register_DOME_tracer(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(DOME_tracer_CS), pointer :: CS !< A pointer that is set to point to the +function register_DOME_tracer(G, GV, US, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(DOME_tracer_CS), pointer :: CS !< A pointer that is set to point to the !! control structure for this module type(tracer_registry_type), pointer :: tr_Reg !< A pointer to the tracer registry. - type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname @@ -75,10 +84,10 @@ 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() ! A pointer to the tracer field + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] 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 + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "DOME_register_tracer called with an "// & @@ -99,6 +108,16 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call log_param(param_file, mdl, "INPUTDIR/DOME_TRACER_IC_FILE", & CS%tracer_IC_file) endif + call get_param(param_file, mdl, "DOME_TRACER_STRIPE_WIDTH", CS%stripe_width, & + "The meridional width of the vertical stripes in the initial condition "//& + "for the DOME tracers.", units=G%y_ax_unit_short, default=50.0) + call get_param(param_file, mdl, "DOME_TRACER_STRIPE_LAT", CS%stripe_s_lat, & + "The southern latitude of the first vertical stripe in the initial condition "//& + "for the DOME tracers.", units=G%y_ax_unit_short, default=350.0) + call get_param(param_file, mdl, "DOME_TRACER_SHEET_SPACING", CS%sheet_spacing, & + "The vertical spacing between successive horizontal sheets of tracer in the initial "//& + "conditions for the DOME tracers, and twice the thickness of these tracer sheets.", & + units="m", default=600.0, scale=US%m_to_Z) 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 "//& @@ -118,7 +137,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! 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, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., restart_CS=restart_CS, & flux_units=trim(flux_units), flux_scale=GV%H_to_MKS) @@ -154,16 +173,16 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables - real, allocatable :: temp(:,:,:) + real, allocatable :: temp(:,:,:) ! Target values for the tracers in the sponges, perhaps in [g kg-1] character(len=16) :: name ! A variable's name in a NetCDF file. - real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to the tracer field - real :: tr_y ! Initial zonally uniform tracer concentrations. + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] + real :: tr_y ! Initial zonally uniform tracer concentrations, perhaps in [g kg-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: 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. + real :: d_tr ! A change in tracer concentrations, in tracer units, perhaps [g kg-1] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB @@ -194,24 +213,25 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & enddo ! This sets a stripe of tracer across the basin. - do m=2,NTR ; do j=js,je ; do i=is,ie + do m=2,min(6,NTR) ; do j=js,je ; do i=is,ie tr_y = 0.0 - if ((m <= 6) .and. (G%geoLatT(i,j) > (300.0+50.0*real(m-1))) .and. & - (G%geoLatT(i,j) < (350.0+50.0*real(m-1)))) tr_y = 1.0 + if ((G%geoLatT(i,j) > (CS%stripe_s_lat + CS%stripe_width*real(m-2))) .and. & + (G%geoLatT(i,j) < (CS%stripe_s_lat + CS%stripe_width*real(m-1)))) & + tr_y = 1.0 do k=1,nz ! This adds the stripes of tracer to every layer. CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + tr_y enddo enddo ; enddo ; enddo - if (NTR > 7) then + if (NTR >= 7) then do j=js,je ; do i=is,ie e(1) = 0.0 do k=1,nz e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z do m=7,NTR - e_top = (-600.0*real(m-1) + 3000.0) * US%m_to_Z - e_bot = (-600.0*real(m-1) + 2700.0) * US%m_to_Z + e_top = -CS%sheet_spacing * (real(m-6)) + e_bot = -CS%sheet_spacing * (real(m-6) + 0.5) if (e_top < e(K)) then if (e_top < e(K+1)) then ; d_tr = 0.0 elseif (e_bot < e(K+1)) then @@ -255,8 +275,7 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! do m=1,NTR do m=1,1 - ! This is needed to force the compiler not to do a copy in the sponge - ! calls. Curses on the designers and implementers of Fortran90. + ! This pointer is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) call set_up_sponge_field(temp, tr_ptr, G, GV, nz, sponge_CSp) enddo diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 3cbed68467..131110e6b2 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -27,6 +27,7 @@ module MOM_generic_tracer use g_tracer_utils, only: g_tracer_get_next,g_tracer_type,g_tracer_is_prog,g_tracer_flux_init use g_tracer_utils, only: g_tracer_send_diag,g_tracer_get_values use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_tracer_set_csdiag + use g_tracer_utils, only: g_tracer_get_obc_segment_props use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS use MOM_coms, only : EFP_type, max_across_PEs, min_across_PEs, PE_here @@ -39,6 +40,8 @@ module MOM_generic_tracer use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_open_boundary, only : ocean_OBC_type + use MOM_open_boundary, only : register_obgc_segments, fill_obgc_segments + use MOM_open_boundary, only : set_obgc_segments_props use MOM_restart, only : register_restart_field, query_initialized, set_initialized, MOM_restart_CS use MOM_spatial_means, only : global_area_mean, global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS @@ -65,6 +68,7 @@ module MOM_generic_tracer public MOM_generic_flux_init public MOM_generic_tracer_min_max public MOM_generic_tracer_fluxes_accumulate + public register_MOM_generic_tracer_segments !> Control structure for generic tracers type, public :: MOM_generic_tracer_CS ; private @@ -79,7 +83,7 @@ module MOM_generic_tracer 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() !< Restart control structure - + type(ocean_OBC_type), pointer :: OBC => NULL() ! Pointer to the first element of the linked list of generic tracers. type(g_tracer_type), pointer :: g_tracer_list => NULL() @@ -98,10 +102,9 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer !! advection and diffusion module. type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct - ! Local variables logical :: register_MOM_generic_tracer - + logical :: obc_has ! This include declares and sets the variable "version". # include "version_variable.h" @@ -112,6 +115,8 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) integer :: ntau, axes(3) type(g_tracer_type), pointer :: g_tracer,g_tracer_next character(len=fm_string_len) :: g_tracer_name,longname,units + character(len=fm_string_len) :: obc_src_file_name,obc_src_field_name + real :: lfac_in,lfac_out real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr real, dimension(HI%isd:HI%ied, HI%jsd:HI%jed,GV%ke) :: grid_tmask @@ -156,7 +161,6 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%restart_CSp => restart_CS - ntau=1 ! MOM needs the fields at only one time step @@ -216,6 +220,52 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) register_MOM_generic_tracer = .true. end function register_MOM_generic_tracer + !> Register OBC segments for generic tracers + subroutine register_MOM_generic_tracer_segments(CS, GV, OBC, tr_Reg, param_file) + type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies whether, + !! where, and what open boundary conditions are used. + type(tracer_registry_type), pointer :: tr_Reg !< Pointer to the control structure for the tracer + !! advection and diffusion module. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + ! Local variables + logical :: obc_has + ! This include declares and sets the variable "version". +# include "version_variable.h" + + character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer_segments' + type(g_tracer_type), pointer :: g_tracer,g_tracer_next + character(len=fm_string_len) :: g_tracer_name + character(len=fm_string_len) :: obc_src_file_name,obc_src_field_name + real :: lfac_in,lfac_out + + if (.NOT. associated(OBC)) return + !Get the tracer list + call generic_tracer_get_list(CS%g_tracer_list) + if (.NOT. associated(CS%g_tracer_list)) call MOM_error(FATAL, trim(sub_name)//& + ": No tracer in the list.") + + g_tracer=>CS%g_tracer_list + do + call g_tracer_get_alias(g_tracer,g_tracer_name) + if (g_tracer_is_prog(g_tracer)) then + call g_tracer_get_obc_segment_props(g_tracer,g_tracer_name,obc_has ,& + obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + if (obc_has) then + call set_obgc_segments_props(OBC,g_tracer_name,obc_src_file_name,obc_src_field_name,lfac_in,lfac_out) + call register_obgc_segments(GV, OBC, tr_Reg, param_file, g_tracer_name) + endif + endif + + !traverse the linked list till hit NULL + call g_tracer_get_next(g_tracer, g_tracer_next) + if (.NOT. associated(g_tracer_next)) exit + g_tracer=>g_tracer_next + + enddo + + end subroutine register_MOM_generic_tracer_segments !> Initialize phase II: Initialize required variables for generic tracers !! There are some steps of initialization that cannot be done in register_MOM_generic_tracer !! This is the place and time to do them: @@ -244,7 +294,7 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, !! ALE sponges. character(len=128), parameter :: sub_name = 'initialize_MOM_generic_tracer' - logical :: OK + logical :: OK,obc_has integer :: i, j, k, isc, iec, jsc, jec, nk type(g_tracer_type), pointer :: g_tracer,g_tracer_next character(len=fm_string_len) :: g_tracer_name @@ -348,6 +398,8 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, call set_initialized(tr_ptr, g_tracer_name, CS%restart_CSp) endif + call g_tracer_get_obc_segment_props(g_tracer,g_tracer_name,obc_has ) + if(obc_has .and. g_tracer_is_prog(g_tracer)) call fill_obgc_segments(G, GV, OBC, tr_ptr, g_tracer_name) !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) if (.NOT. associated(g_tracer_next)) exit @@ -460,7 +512,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! g_tracer=>CS%g_tracer_list do - if (_ALLOCATED(g_tracer%trunoff)) then + if (_ALLOCATED(g_tracer%trunoff) .and. (.NOT. g_tracer%runoff_added_to_stf)) then call g_tracer_get_alias(g_tracer,g_tracer_name) call g_tracer_get_pointer(g_tracer,g_tracer_name,'stf', stf_array) call g_tracer_get_pointer(g_tracer,g_tracer_name,'trunoff',trunoff_array) @@ -469,6 +521,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * & US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) stf_array = stf_array + runoff_tracer_flux_array + g_tracer%runoff_added_to_stf = .true. endif !traverse the linked list till hit NULL diff --git a/src/tracer/MOM_hor_bnd_diffusion.F90 b/src/tracer/MOM_hor_bnd_diffusion.F90 index d0920ee117..b89552e8e4 100644 --- a/src/tracer/MOM_hor_bnd_diffusion.F90 +++ b/src/tracer/MOM_hor_bnd_diffusion.F90 @@ -11,11 +11,10 @@ module MOM_hor_bnd_diffusion use MOM_domains, only : pass_var use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : post_data, register_diag_field -use MOM_diag_vkernels, only : reintegrate_column use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_remapping, only : remapping_CS, initialize_remapping +use MOM_remapping, only : remapping_CS, initialize_remapping, reintegrate_column use MOM_remapping, only : extract_member_remapping_CS, remapping_core_h use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme use MOM_spatial_means, only : global_mass_integral @@ -764,7 +763,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ enddo ! remap flux to h_vel (native grid) - call reintegrate_column(nk, dz_top(:), F_layer_z(:), ke, h_vel(:), 0.0, F_layer(:)) + call reintegrate_column(nk, dz_top(:), F_layer_z(:), ke, h_vel(:), F_layer(:)) ! used to avoid fluxes below hbl if (CS%linear) then diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index d09c3e2870..cdabfa1277 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -48,7 +48,7 @@ module MOM_neutral_diffusion logical :: hard_fail_heff !< Bring down the model if a problem with heff is detected integer :: max_iter !< Maximum number of iterations if refine_position is defined real :: drho_tol !< Convergence criterion representing density difference from true neutrality [R ~> kg m-3] - real :: x_tol !< Convergence criterion for how small an update of the position can be + real :: x_tol !< Convergence criterion for how small an update of the position can be [nondim] real :: ref_pres !< Reference pressure, negative if using locally referenced neutral !! density [R L2 T-2 ~> Pa] logical :: interior_only !< If true, only applies neutral diffusion in the ocean interior. @@ -56,15 +56,15 @@ module MOM_neutral_diffusion logical :: use_unmasked_transport_bug !< If true, use an older form for the accumulation of !! neutral-diffusion transports that were unmasked, as used prior to Jan 2018. ! Positions of neutral surfaces in both the u, v directions - real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point - real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point + real, allocatable, dimension(:,:,:) :: uPoL !< Non-dimensional position with left layer uKoL-1, u-point [nondim] + real, allocatable, dimension(:,:,:) :: uPoR !< Non-dimensional position with right layer uKoR-1, u-point [nondim] integer, allocatable, dimension(:,:,:) :: uKoL !< Index of left interface corresponding to neutral surface, !! at a u-point integer, allocatable, dimension(:,:,:) :: uKoR !< Index of right interface corresponding to neutral surface, !! at a u-point real, allocatable, dimension(:,:,:) :: uHeff !< Effective thickness at u-point [H ~> m or kg m-2] - real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point - real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point + real, allocatable, dimension(:,:,:) :: vPoL !< Non-dimensional position with left layer uKoL-1, v-point [nondim] + real, allocatable, dimension(:,:,:) :: vPoR !< Non-dimensional position with right layer uKoR-1, v-point [nondim] integer, allocatable, dimension(:,:,:) :: vKoL !< Index of left interface corresponding to neutral surface, !! at a v-point integer, allocatable, dimension(:,:,:) :: vKoR !< Index of right interface corresponding to neutral surface, @@ -167,7 +167,7 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, call get_param(param_file, mdl, "NDIFF_REF_PRES", CS%ref_pres, & "The reference pressure (Pa) used for the derivatives of "//& "the equation of state. If negative (default), local pressure is used.", & - units="Pa", default = -1., scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=-1., scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "NDIFF_INTERIOR_ONLY", CS%interior_only, & "If true, only applies neutral diffusion in the ocean interior."//& "That is, the algorithm will exclude the surface and bottom"//& @@ -229,26 +229,26 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, " pressure dependence", & default="mid_pressure") if (CS%neutral_pos_method > 1) then - call get_param(param_file, mdl, "NDIFF_DRHO_TOL", CS%drho_tol, & - "Sets the convergence criterion for finding the neutral\n"// & - "position within a layer in kg m-3.", & - default=1.e-10, scale=US%kg_m3_to_R) - call get_param(param_file, mdl, "NDIFF_X_TOL", CS%x_tol, & - "Sets the convergence criterion for a change in nondim\n"// & - "position within a layer.", & - default=0.) + call get_param(param_file, mdl, "NDIFF_DRHO_TOL", CS%drho_tol, & + "Sets the convergence criterion for finding the neutral "// & + "position within a layer in kg m-3.", & + units="kg m-3", default=1.e-10, scale=US%kg_m3_to_R) + call get_param(param_file, mdl, "NDIFF_X_TOL", CS%x_tol, & + "Sets the convergence criterion for a change in nondimensional "// & + "position within a layer.", & + units="nondim", default=0.) call get_param(param_file, mdl, "NDIFF_MAX_ITER", CS%max_iter, & - "The maximum number of iterations to be done before \n"// & + "The maximum number of iterations to be done before "// & "exiting the iterative loop to find the neutral surface", & default=10) endif call get_param(param_file, mdl, "NDIFF_DEBUG", CS%debug, & "Turns on verbose output for discontinuous neutral "//& "diffusion routines.", & - default = .false.) + default=.false.) call get_param(param_file, mdl, "HARD_FAIL_HEFF", CS%hard_fail_heff, & "Bring down the model if a problem with heff is detected",& - default = .true.) + default=.true.) endif if (CS%interior_only) then diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 0a56925516..7619cac2bd 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -7,7 +7,6 @@ module MOM_offline_aux use MOM_debugging, only : check_column_integrals use MOM_domains, only : pass_var, pass_vector, To_All use MOM_diag_mediator, only : post_data -use MOM_diag_vkernels, only : reintegrate_column use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_forcing_type, only : forcing @@ -778,9 +777,9 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array [ppt ~> S] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array [S ~> ppt] real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array [C ~> degC] - real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array [ppt ~> S] + real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array [S ~> ppt] integer :: i, j, k, is, ie, js, je, nz real, parameter :: fill_value = 0. diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index bf06fc294e..2200a28c2b 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -205,7 +205,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C h_pre, uhtr, vhtr, converged) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval covered by this call [s] + real, intent(in) :: time_interval !< time interval covered by this call [T ~> s] type(ocean_grid_type), intent(inout) :: 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 @@ -846,7 +846,7 @@ end subroutine offline_fw_fluxes_out_ocean subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS, h_pre, eatr, ebtr, uhtr, vhtr) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< Offline transport time interval [s] + real, intent(in) :: time_interval !< Offline transport time interval [T ~> s] type(ocean_grid_type), intent(inout) :: 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 @@ -894,7 +894,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - dt_iter = US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) + dt_iter = time_interval / real(max(1, CS%num_off_iter)) x_before_y = CS%x_before_y do iter=1,CS%num_off_iter diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 85a858b8df..c089181c16 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -4,7 +4,7 @@ module MOM_tracer_Z_init ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe -! use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : MOM_read_data, get_var_sizes, read_attribute, read_variable use MOM_io, only : open_file_to_read, close_file_to_read @@ -279,7 +279,7 @@ subroutine tracer_z_init_array(tr_in, z_edges, nk_data, e, land_fill, G, nlay, n intent(in) :: tr_in !< The z-space array of tracer concentrations !! that is read in [A] real, dimension(nk_data+1), intent(in) :: z_edges !< The depths of the cell edges in the input z* data - !! [Z ~> m or m] + !! [Z ~> m] or [m] integer, intent(in) :: nlay !< The number of vertical layers in the target grid real, dimension(SZI_(G),SZJ_(G),nlay+1), & intent(in) :: e !< The depths of the target layer interfaces [Z ~> m] or [m] @@ -556,8 +556,8 @@ end function find_limited_slope !> This subroutine determines the potential temperature and salinity that !! is consistent with the target density using provided initial guess -subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, GV, US, & - EOS, h_massless) +subroutine determine_temperature(temp, salt, R_tgt, EOS, p_ref, niter, h, k_start, G, GV, US, & + PF, just_read, h_massless) 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)), & @@ -565,6 +565,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: salt !< salinity [S ~> ppt] real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. + type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations integer, intent(in) :: k_start !< starting index (i.e. below the buffer layer) @@ -572,7 +573,10 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, intent(in) :: h !< layer thickness, used only to avoid working on !! massless layers [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(EOS_type), intent(in) :: EOS !< seawater equation of state control structure + type(param_file_type), intent(in) :: PF !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T or S. real, optional, intent(in) :: h_massless !< A threshold below which a layer is !! determined to be massless [H ~> m or kg m-2] @@ -600,29 +604,69 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, ! when old_fit is true [C ~> degC] real :: max_s_adj ! The largest permitted salinity changes with each iteration ! when old_fit is true [S ~> ppt] - logical :: adjust_salt, old_fit + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "determine_temperature" ! This subroutine's name. + logical :: adjust_salt, fit_together integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! These hard coded parameters need to be set properly. - S_min = 0.5*US%ppt_to_S ; S_max = 65.0*US%ppt_to_S - T_max = 31.0*US%degC_to_C ; T_min = -2.0*US%degC_to_C - max_t_adj = 1.0*US%degC_to_C - max_s_adj = 0.5*US%ppt_to_S - tol_T = 1.0e-4*US%degC_to_C - tol_S = 1.0e-4*US%ppt_to_S - tol_rho = 1.0e-4*US%kg_m3_to_R - old_fit = .true. ! reproduces siena behavior + ! ### The algorithms of determine_temperature subroutine needs to be reexamined. - dT_dS_gauge = 10.0*US%degC_to_C*US%S_to_ppt ! 10 degC is weighted equivalently to 1 ppt. - ! ### The whole determine_temperature subroutine needs to be reexamined, both the algorithms - ! and the extensive use of hard-coded dimensional parameters. + call log_version(PF, mdl, version, "") - ! We will switch to the newer method which simultaneously adjusts + ! We should switch the default to the newer method which simultaneously adjusts ! temp and salt based on the ratio of the thermal and haline coefficients, once it is tested. + call get_param(PF, mdl, "DETERMINE_TEMP_ADJUST_T_AND_S", fit_together, & + "If true, simltaneously adjust the estimates of the temperature and salinity "//& + "based on the ratio of the thermal and haline coefficients. Otherwise try to "//& + "match the density by only adjusting temperatures within a maximum range before "//& + "revising estimates of the salinity.", default=.false., do_not_log=just_read) + ! These hard coded parameters need to be set properly. + call get_param(PF, mdl, "DETERMINE_TEMP_T_MIN", T_min, & + "The minimum temperature that can be found by determine_temperature.", & + units="degC", default=-2.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_T_MAX", T_max, & + "The maximum temperature that can be found by determine_temperature.", & + units="degC", default=31.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_MIN", S_min, & + "The minimum salinity that can be found by determine_temperature.", & + units="1e-3", default=0.5, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_MAX", S_max, & + "The maximum salinity that can be found by determine_temperature.", & + units="1e-3", default=65.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_T_TOLERANCE", tol_T, & + "The convergence tolerance for temperature in determine_temperature.", & + units="degC", default=1.0e-4, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_TOLERANCE", tol_S, & + "The convergence tolerance for temperature in determine_temperature.", & + units="1e-3", default=1.0e-4, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_RHO_TOLERANCE", tol_rho, & + "The convergence tolerance for density in determine_temperature.", & + units="kg m-3", default=1.0e-4, scale=US%kg_m3_to_R, do_not_log=just_read) + if (fit_together) then + ! By default 10 degC is weighted equivalently to 1 ppt when minimizing changes. + call get_param(PF, mdl, "DETERMINE_TEMP_DT_DS_WEIGHT", dT_dS_gauge, & + "When extrapolating T & S to match the layer target densities, this "//& + "factor (in deg C / PSU) is combined with the derivatives of density "//& + "with T & S to determine what direction is orthogonal to density contours. "//& + "It could be based on a typical value of (dR/dS) / (dR/dT) in oceanic profiles.", & + units="degC PSU-1", default=10.0, scale=US%degC_to_C*US%S_to_ppt) + else + call get_param(PF, mdl, "DETERMINE_TEMP_T_ADJ_RANGE", max_t_adj, & + "The maximum amount by which the initial layer temperatures can be "//& + "modified in determine_temperature.", & + units="degC", default=1.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(PF, mdl, "DETERMINE_TEMP_S_ADJ_RANGE", max_S_adj, & + "The maximum amount by which the initial layer salinities can be "//& + "modified in determine_temperature.", & + units="1e-3", default=0.5, scale=US%ppt_to_S, do_not_log=just_read) + endif + + if (just_read) return ! All run-time parameters have been read, so return. press(:) = p_ref EOSdom(:) = EOS_domain(G%HI) @@ -643,7 +687,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, do k=k_start,nz ; do i=is,ie ! if (abs(rho(i,k)-R_tgt(k))>tol_rho .and. hin(i,k)>h_massless .and. abs(T(i,k)-land_fill) < epsln) then if (abs(rho(i,k)-R_tgt(k))>tol_rho) then - if (old_fit) then + if (.not.fit_together) then dT(i,k) = max(min((R_tgt(k)-rho(i,k)) / drho_dT(i,k), max_t_adj), -max_t_adj) T(i,k) = max(min(T(i,k)+dT(i,k), T_max), T_min) else @@ -662,7 +706,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, h, k_start, G, endif enddo iter_loop - if (adjust_salt .and. old_fit) then ; do itt = 1,niter + if (adjust_salt .and. .not.fit_together) then ; do itt = 1,niter do k=1,nz call calculate_density(T(:,k), S(:,k), press, rho(:,k), EOS, EOSdom ) call calculate_density_derivs(T(:,k), S(:,k), press, drho_dT(:,k), drho_dS(:,k), & diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 6d238a8e86..5abca6e578 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -157,7 +157,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) ! In the case that the layer is now dramatically thinner than it was previously, @@ -167,7 +167,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) enddo ; enddo else - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie hprev(i,j,k) = vol_prev(i,j,k) enddo ; enddo endif diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 58bada441f..5d227defec 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -60,6 +60,7 @@ module MOM_tracer_flow_control use MOM_generic_tracer, only : MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state use MOM_generic_tracer, only : end_MOM_generic_tracer, MOM_generic_tracer_get, MOM_generic_flux_init use MOM_generic_tracer, only : MOM_generic_tracer_stock, MOM_generic_tracer_min_max, MOM_generic_tracer_CS +use MOM_generic_tracer, only : register_MOM_generic_tracer_segments use pseudo_salt_tracer, only : register_pseudo_salt_tracer, initialize_pseudo_salt_tracer use pseudo_salt_tracer, only : pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state use pseudo_salt_tracer, only : pseudo_salt_stock, pseudo_salt_tracer_end, pseudo_salt_tracer_CS @@ -75,6 +76,7 @@ module MOM_tracer_flow_control public call_tracer_register, tracer_flow_control_init, call_tracer_set_forcing public call_tracer_column_fns, call_tracer_surface_state, call_tracer_stocks public call_tracer_flux_init, get_chl_from_model, tracer_flow_control_end +public call_tracer_register_obc_segments !> The control structure for orchestrating the calling of tracer packages type, public :: tracer_flow_control_CS ; private @@ -114,6 +116,7 @@ module MOM_tracer_flow_control contains + !> This subroutine carries out a series of calls to initialize the air-sea !! tracer fluxes, but it does not record the generated indicies, and it may !! be called _before_ the ocean model has been initialized and may be called @@ -149,8 +152,8 @@ end subroutine call_tracer_flux_init !> This subroutine determines which tracer packages are to be used and does the calls to !! register their tracers to be advected, diffused, and read from restarts. -subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. +subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time @@ -160,10 +163,9 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) 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), intent(inout) :: restart_CS !< A pointer to the restart control + type(MOM_restart_CS), intent(inout) :: 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 = "MOM_tracer_flow_control" ! This module's name. @@ -176,8 +178,7 @@ subroutine call_tracer_register(HI, GV, US, 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, "") - call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", & - CS%use_USER_tracer_example, & + call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", CS%use_USER_tracer_example, & "If true, use the USER_tracer_example tracer package.", & default=.false.) call get_param(param_file, mdl, "USE_DOME_TRACER", CS%use_DOME_tracer, & @@ -228,49 +229,49 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! tracer package registration call returns a logical false if it cannot be run ! for some reason. This then overrides the run-time selection from above. if (CS%use_USER_tracer_example) CS%use_USER_tracer_example = & - USER_register_tracer_example(HI, GV, param_file, CS%USER_tracer_example_CSp, & + USER_register_tracer_example(G, GV, US, param_file, CS%USER_tracer_example_CSp, & tr_Reg, restart_CS) if (CS%use_DOME_tracer) CS%use_DOME_tracer = & - register_DOME_tracer(HI, GV, param_file, CS%DOME_tracer_CSp, & + register_DOME_tracer(G, GV, US, param_file, CS%DOME_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ISOMIP_tracer) CS%use_ISOMIP_tracer = & - register_ISOMIP_tracer(HI, GV, param_file, CS%ISOMIP_tracer_CSp, & + register_ISOMIP_tracer(G%HI, GV, param_file, CS%ISOMIP_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_RGC_tracer) CS%use_RGC_tracer = & - register_RGC_tracer(HI, GV, param_file, CS%RGC_tracer_CSp, & + register_RGC_tracer(G, GV, param_file, CS%RGC_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_ideal_age) CS%use_ideal_age = & - register_ideal_age_tracer(HI, GV, param_file, CS%ideal_age_tracer_CSp, & + register_ideal_age_tracer(G%HI, GV, param_file, CS%ideal_age_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_regional_dyes) CS%use_regional_dyes = & - register_dye_tracer(HI, GV, US, param_file, CS%dye_tracer_CSp, & + register_dye_tracer(G%HI, GV, US, param_file, CS%dye_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_oil) CS%use_oil = & - register_oil_tracer(HI, GV, US, param_file, CS%oil_tracer_CSp, & + register_oil_tracer(G%HI, GV, US, param_file, CS%oil_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_advection_test_tracer) CS%use_advection_test_tracer = & - register_advection_test_tracer(HI, GV, param_file, CS%advection_test_tracer_CSp, & + register_advection_test_tracer(G, GV, param_file, CS%advection_test_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_OCMIP2_CFC) CS%use_OCMIP2_CFC = & - register_OCMIP2_CFC(HI, GV, param_file, CS%OCMIP2_CFC_CSp, & + register_OCMIP2_CFC(G%HI, GV, param_file, CS%OCMIP2_CFC_CSp, & tr_Reg, restart_CS) if (CS%use_CFC_cap) CS%use_CFC_cap = & - register_CFC_cap(HI, GV, param_file, CS%CFC_cap_CSp, & + register_CFC_cap(G%HI, GV, param_file, CS%CFC_cap_CSp, & tr_Reg, restart_CS) if (CS%use_MOM_generic_tracer) CS%use_MOM_generic_tracer = & - register_MOM_generic_tracer(HI, GV, param_file, CS%MOM_generic_tracer_CSp, & + register_MOM_generic_tracer(G%HI, GV, param_file, CS%MOM_generic_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_pseudo_salt_tracer) CS%use_pseudo_salt_tracer = & - register_pseudo_salt_tracer(HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & + register_pseudo_salt_tracer(G%HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_boundary_impulse_tracer) CS%use_boundary_impulse_tracer = & - register_boundary_impulse_tracer(HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & + register_boundary_impulse_tracer(G%HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & 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, & + register_dyed_obc_tracer(G%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, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) + register_nw2_tracers(G%HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register @@ -357,13 +358,34 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag end subroutine tracer_flow_control_init +!> This subroutine calls all registered tracers to register their OBC segments +!! similar to register_temp_salt_segments for T&S +subroutine call_tracer_register_obc_segments(GV, param_file, CS, tr_Reg, OBC) + 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(tracer_flow_control_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. + 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(ocean_OBC_type), pointer :: OBC !< This open boundary condition + !! type specifies whether, where, + !! and what open boundary + !! conditions are used. + + if (CS%use_MOM_generic_tracer) & + call register_MOM_generic_tracer_segments(CS%MOM_generic_tracer_CSp, GV, OBC, tr_Reg, param_file) + +end subroutine call_tracer_register_obc_segments + !> This subroutine extracts the chlorophyll concentrations from the model state, if possible subroutine get_chl_from_model(Chl_array, G, GV, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: Chl_array !< The array in which to store the model's - !! Chlorophyll-A concentrations in mg m-3. + !! Chlorophyll-A concentrations [mg m-3]. type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to call_tracer_register. @@ -619,21 +641,28 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock logical, dimension(:), & optional, intent(inout) :: got_min_max !< Indicates whether the global min and !! max are found for each tracer - real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer - real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer - real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum - real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum - real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum - real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum - real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum - real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum + real, dimension(:), optional, intent(out) :: global_min !< The global minimum of each tracer [conc] + real, dimension(:), optional, intent(out) :: global_max !< The global maximum of each tracer [conc] + real, dimension(:), optional, intent(out) :: xgmin !< The x-position of the global minimum in the + !! units of G%geoLonT, often [degrees_E] or [km] + real, dimension(:), optional, intent(out) :: ygmin !< The y-position of the global minimum in the + !! units of G%geoLatT, often [degrees_N] or [km] + real, dimension(:), optional, intent(out) :: zgmin !< The z-position of the global minimum [layer] + real, dimension(:), optional, intent(out) :: xgmax !< The x-position of the global maximum in the + !! units of G%geoLonT, often [degrees_E] or [km] + real, dimension(:), optional, intent(out) :: ygmax !< The y-position of the global maximum in the + !! units of G%geoLatT, often [degrees_N] or [km] + real, dimension(:), optional, intent(out) :: zgmax !< The z-position of the global maximum [layer] ! Local variables character(len=200), dimension(MAX_FIELDS_) :: names, units character(len=200) :: set_pkg_name - ! real, dimension(MAX_FIELDS_) :: values - type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP - type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP + ! real, dimension(MAX_FIELDS_) :: values ! Globally integrated tracer amounts in a + ! new list for each tracer package [kg conc] + type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP ! Globally integrated tracer amounts in a + ! new list for each tracer package [kg conc] + type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP ! Globally integrated tracer amounts in a + ! single master list for all tracers [kg conc] integer :: max_ns, ns_tot, ns, index, nn, n if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_stocks: "// & @@ -742,12 +771,12 @@ subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, character(len=*), dimension(:), & intent(in) :: units !< Units to use in the metadata for each stock. type(EFP_type), dimension(:), & - intent(in) :: values !< The values of the tracer stocks + intent(in) :: values !< The values of the tracer stocks [conc kg] integer, intent(in) :: index !< The integer stock index from !! stocks_constants_mod of the stock to be returned. If this is !! present and greater than 0, only a single stock can be returned. type(EFP_type), dimension(:), & - intent(inout) :: stock_values !< The master list of stock values + intent(inout) :: stock_values !< The master list of stock values [conc kg] character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose !! stocks were stored for a specific index. This is !! used to trigger an error if there are redundant stocks. diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index bee9d2984b..79e99f8bb7 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -86,7 +86,7 @@ module MOM_tracer_hor_diff !> A type that can be used to create arrays of pointers to 2D arrays type p2d - real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of reals + real, dimension(:,:), pointer :: p => NULL() !< A pointer to a 2D array of reals [various] end type p2d !> A type that can be used to create arrays of pointers to 2D integer arrays type p2di @@ -123,12 +123,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online ! Optional inputs for offline tracer transport logical, optional, intent(in) :: do_online_flag !< If present and true, do online !! tracer transport with stored velocities. + ! The next two arguments do not appear to be used anywhere. real, dimension(SZIB_(G),SZJ_(G)), & - optional, intent(in) :: read_khdt_x !< If present, these are the zonal - !! diffusivities from previous run. + optional, intent(in) :: read_khdt_x !< If present, these are the zonal diffusivities + !! times a timestep from a previous run [L2 ~> m2] real, dimension(SZI_(G),SZJB_(G)), & - optional, intent(in) :: read_khdt_y !< If present, these are the meridional - !! diffusivities from previous run. + optional, intent(in) :: read_khdt_y !< If present, these are the meridional diffusivities + !! times a timestep from a previous run [L2 ~> m2] real, dimension(SZI_(G),SZJ_(G)) :: & @@ -152,10 +153,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online Kh_v ! Tracer mixing coefficient at u-points [L2 T-1 ~> m2 s-1]. real :: khdt_max ! The local limiting value of khdt_x or khdt_y [L2 ~> m2]. - real :: max_CFL ! The global maximum of the diffusive CFL number. + real :: max_CFL ! The global maximum of the diffusive CFL number [nondim] logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: i, j, k, m, is, ie, js, je, nz, ntr, itt, num_itts - real :: I_numitts ! The inverse of the number of iterations, num_itts. + real :: I_numitts ! The inverse of the number of iterations, num_itts [nondim] real :: scale ! The fraction of khdt_x or khdt_y that is applied in this ! layer for this iteration [nondim]. real :: Idt ! The inverse of the time step [T-1 ~> s-1]. @@ -164,7 +165,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real :: Kh_loc ! The local value of Kh [L2 T-1 ~> m2 s-1]. real :: Res_Fn ! The local value of the resolution function [nondim]. real :: Rd_dx ! The local value of deformation radius over grid-spacing [nondim]. - real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. + real :: normalize ! normalization used for diagnostic Kh_h [nondim]; diffusivity averaged to h-points. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -337,11 +338,11 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online else ! .not. do_online !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie - khdt_x(I,j) = US%m_to_L**2*read_khdt_x(I,j) + khdt_x(I,j) = read_khdt_x(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie - khdt_y(i,J) = US%m_to_L**2*read_khdt_y(i,J) + khdt_y(i,J) = read_khdt_y(i,J) enddo ; enddo call pass_vector(khdt_x, khdt_y, G%Domain) endif ! do_online @@ -561,7 +562,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online enddo ; enddo do j=js,je ; do i=is,ie normalize = 1.0 / ((G%mask2dCu(I-1,j)+G%mask2dCu(I,j)) + & - (G%mask2dCv(i,J-1)+G%mask2dCv(i,J)) + GV%H_subroundoff) + (G%mask2dCv(i,J-1)+G%mask2dCv(i,J)) + 1.0e-37) Kh_h(i,j) = normalize*G%mask2dT(i,j)*((Kh_u(I-1,j)+Kh_u(I,j)) + & (Kh_v(i,J-1)+Kh_v(i,J))) enddo ; enddo @@ -633,24 +634,36 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & k0b_Lv, k0a_Lv, & ! The original k-indices of the layers that participate k0b_Rv, k0a_Rv ! in each pair of mixing at v-faces. + !### Accumulating the converge into this array one face at a time may lead to a lack of rotational symmetry. real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: & tr_flux_conv ! The flux convergence of tracers [conc H L2 ~> conc m3 or conc kg] - real, dimension(SZI_(G), SZJ_(G),SZK_(GV)) :: Tr_flux_3d, Tr_adj_vert_L, Tr_adj_vert_R + + ! The following 3-d arrays were created in 2014 in MOM6 PR#12 to facilitate openMP threading + ! on an i-loop, which might have been ill advised. The k-size extents here might also be problematic. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & + Tr_flux_3d, & ! The tracer flux through pairings at meridional faces [conc H L2 ~> conc m3 or conc kg] + Tr_adj_vert_L, & ! Vertical adjustments to which layer the fluxes go into in the southern + ! columns at meridional face [conc H L2 ~> conc m3 or conc kg] + Tr_adj_vert_R ! Vertical adjustments to which layer the fluxes go into in the northern + ! columns at meridional face [conc H L2 ~> conc m3 or conc kg] real, dimension(SZI_(G),SZK_(GV), SZJ_(G)) :: & rho_srt, & ! The density of each layer of the sorted columns [R ~> kg m-3]. h_srt ! The thickness of each layer of the sorted columns [H ~> m or kg m-2]. integer, dimension(SZI_(G),SZK_(GV), SZJ_(G)) :: & - k0_srt ! The original k-index that each layer of the sorted column - ! corresponds to. + k0_srt ! The original k-index that each layer of the sorted column corresponds to. real, dimension(SZK_(GV)) :: & - h_demand_L, & ! The thickness in the left (_L) or right (_R) column that - h_demand_R, & ! is demanded to match the thickness in the counterpart [H ~> m or kg m-2]. - h_used_L, & ! The summed thickness from the left or right columns that - h_used_R, & ! have actually been used [H ~> m or kg m-2]. - h_supply_frac_L, & ! The fraction of the demanded thickness that can - h_supply_frac_R ! actually be supplied from a layer. + h_demand_L, & ! The thickness in the left column that is demanded to match the thickness + ! in the counterpart [H ~> m or kg m-2]. + h_demand_R, & ! The thickness in the right column that is demanded to match the thickness + ! in the counterpart [H ~> m or kg m-2]. + h_used_L, & ! The summed thickness from the left column that has actually been used [H ~> m or kg m-2] + h_used_R, & ! The summed thickness from the right columns that has actually been used [H ~> m or kg m-2] + h_supply_frac_L, & ! The fraction of the demanded thickness that can actually be supplied + ! from a layer on the left [nondim]. + h_supply_frac_R ! The fraction of the demanded thickness that can actually be supplied + ! from a layer on the right [nondim]. integer, dimension(SZI_(G), SZJ_(G)) :: & num_srt, & ! The number of layers that are sorted in each column. k_end_srt, & ! The maximum index in each column that might need to be @@ -666,17 +679,17 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & real :: h_exclude ! A thickness that layers must attain to be considered ! for inclusion in mixing [H ~> m or kg m-2]. real :: Idt ! The inverse of the time step [T-1 ~> s-1]. - real :: I_maxitt ! The inverse of the maximum number of iterations. + real :: I_maxitt ! The inverse of the maximum number of iterations [nondim] real :: rho_pair, rho_a, rho_b ! Temporary densities [R ~> kg m-3]. - real :: Tr_min_face ! The minimum and maximum tracer concentrations - real :: Tr_max_face ! associated with a pairing [Conc] - real :: Tr_La, Tr_Lb ! The 4 tracer concentrations that might be - real :: Tr_Ra, Tr_Rb ! associated with a pairing [Conc] - real :: Tr_av_L ! The average tracer concentrations on the left and right - real :: Tr_av_R ! sides of a pairing [Conc]. + real :: Tr_min_face ! The minimum tracer concentration associated with a pairing [Conc] + real :: Tr_max_face ! The maximum tracer concentration associated with a pairing [Conc] + real :: Tr_La, Tr_Lb ! The 2 left-side tracer concentrations that might be associated with a pairing [Conc] + real :: Tr_Ra, Tr_Rb ! The 2 right-side tracer concentrations that might be associated with a pairing [Conc] + real :: Tr_av_L ! The average tracer concentrations on the left side of a pairing [Conc]. + real :: Tr_av_R ! The average tracer concentrations on the right side of a pairing [Conc]. real :: Tr_flux ! The tracer flux from left to right in a pair [conc H L2 ~> conc m3 or conc kg]. - real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the - ! two cells that make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. + real :: Tr_adj_vert ! A downward vertical adjustment to Tr_flux between the two cells that + ! make up one side of the pairing [conc H L2 ~> conc m3 or conc kg]. real :: h_L, h_R ! Thicknesses to the left and right [H ~> m or kg m-2]. real :: wt_a, wt_b ! Fractional weights of layers above and below [nondim]. real :: vol ! A cell volume or mass [H L2 ~> m3 or kg]. @@ -690,7 +703,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & left_set, & ! If true, the left or right point determines the density of right_set ! of the trio. If densities are exactly equal, both are true. - real :: tmp + real :: tmp ! A temporary variable used in swaps [various] real :: p_ref_cv(SZI_(G)) ! The reference pressure for the coordinate density [R L2 T-2 ~> Pa] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -1320,7 +1333,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & h_L = hP_Lv(J)%p(i,k) ; h_R = hP_Rv(J)%p(i,k) Tr_flux = I_maxitt * ((2.0 * h_L * h_R) / (h_L + h_R)) * & khdt_epi_y(i,J) * (Tr_av_L - Tr_av_R) - Tr_flux_3d(i,j,k) = Tr_flux + Tr_flux_3d(i,J,k) = Tr_flux if (deep_wt_Lv(J)%p(i,k) < 1.0) then Tr_adj_vert = 0.0 @@ -1346,7 +1359,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & (vol*wt_a)*(Tr_Lb - Tr_La)) endif endif - Tr_adj_vert_L(i,j,k) = Tr_adj_vert + Tr_adj_vert_L(i,J,k) = Tr_adj_vert endif if (deep_wt_Rv(J)%p(i,k) < 1.0) then @@ -1373,7 +1386,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & (vol*wt_a)*(Tr_Rb - Tr_Ra)) endif endif - Tr_adj_vert_R(i,j,k) = Tr_adj_vert + Tr_adj_vert_R(i,J,k) = Tr_adj_vert endif if (associated(Tr(m)%df2d_y)) & Tr(m)%df2d_y(i,J) = Tr(m)%df2d_y(i,J) + Tr_flux * Idt @@ -1384,25 +1397,28 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & !$OMP deep_wt_Rv,k0a_Rv,Tr_adj_vert_R) & !$OMP private(kLa,kLb,kRa,kRb,wt_b,wt_a) do i=is,ie ; do J=js-1,je ; if (G%mask2dCv(i,J) > 0.0) then + ! The non-stride-1 loop order here is to facilitate openMP threading. However, it might be + ! suboptimal when openMP threading is not used, at which point it might be better to fuse + ! these loope with those that precede it and thereby eliminate the need for three 3-d arrays. do k=1,nPv(i,J) kLb = k0b_Lv(J)%p(i,k); kRb = k0b_Rv(J)%p(i,k) if (deep_wt_Lv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - Tr_flux_3d(i,j,k) + tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - Tr_flux_3d(i,J,k) else kLa = k0a_Lv(J)%p(i,k) wt_b = deep_wt_Lv(J)%p(i,k) ; wt_a = 1.0 - wt_b - tr_flux_conv(i,j,kLa) = tr_flux_conv(i,j,kLa) - (wt_a*Tr_flux_3d(i,j,k) + Tr_adj_vert_L(i,j,k)) - tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,j,k) - Tr_adj_vert_L(i,j,k)) + tr_flux_conv(i,j,kLa) = tr_flux_conv(i,j,kLa) - (wt_a*Tr_flux_3d(i,J,k) + Tr_adj_vert_L(i,J,k)) + tr_flux_conv(i,j,kLb) = tr_flux_conv(i,j,kLb) - (wt_b*Tr_flux_3d(i,J,k) - Tr_adj_vert_L(i,J,k)) endif if (deep_wt_Rv(J)%p(i,k) >= 1.0) then - tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,j,k) + tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + Tr_flux_3d(i,J,k) else kRa = k0a_Rv(J)%p(i,k) wt_b = deep_wt_Rv(J)%p(i,k) ; wt_a = 1.0 - wt_b tr_flux_conv(i,j+1,kRa) = tr_flux_conv(i,j+1,kRa) + & - (wt_a*Tr_flux_3d(i,j,k) - Tr_adj_vert_R(i,j,k)) + (wt_a*Tr_flux_3d(i,J,k) - Tr_adj_vert_R(i,J,k)) tr_flux_conv(i,j+1,kRb) = tr_flux_conv(i,j+1,kRb) + & - (wt_b*Tr_flux_3d(i,j,k) + Tr_adj_vert_R(i,j,k)) + (wt_b*Tr_flux_3d(i,J,k) + Tr_adj_vert_R(i,J,k)) endif enddo endif ; enddo ; enddo @@ -1455,8 +1471,8 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic type(param_file_type), intent(in) :: param_file !< parameter file type(tracer_hor_diff_CS), pointer :: CS !< horz diffusion control structure -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_tracer_hor_diff" ! This module's name. if (associated(CS)) then diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 9ceadc602d..474fcb0c23 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -47,13 +47,11 @@ module RGC_tracer character(len = 200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. type(time_type), pointer :: Time !< 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. - real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration. - real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. - real :: lenlat !< the latitudinal or y-direction length of the domain. - real :: lenlon !< the longitudinal or x-direction length of the domain. - real :: CSL !< The length of the continental shelf (x dir, km) - real :: lensponge !< the length of the sponge layer. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package [kg kg-1] + real, pointer :: tr_aux(:,:,:,:) => NULL() !< The masked tracer concentration [kg kg-1] + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out [kg kg-1] + real :: CSL !< The length of the continental shelf (x direction) [km] + real :: lensponge !< the length of the sponge layer [km] logical :: mask_tracers !< If true, tracers are masked out in massless layers. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the timing of diagnostic output. @@ -62,27 +60,26 @@ module RGC_tracer contains - !> This subroutine is used to register tracer fields -function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. +function register_RGC_tracer(G, GV, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(param_file_type), intent(in) :: param_file ! NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers in this module [kg kg-1] logical :: register_RGC_tracer integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "RGC_register_tracer called with an "// & @@ -108,21 +105,13 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) - call get_param(param_file, mdl, "LENLAT", CS%lenlat, & - "The latitudinal or y-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - - call get_param(param_file, mdl, "LENLON", CS%lenlon, & - "The longitudinal or x-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - call get_param(param_file, mdl, "CONT_SHELF_LENGTH", CS%CSL, & "The length of the continental shelf (x dir, km).", & - default=15.0) + units=G%x_ax_unit_short, default=15.0) call get_param(param_file, mdl, "LENSPONGE", CS%lensponge, & "The length of the sponge layer (km).", & - default=10.0) + units=G%x_ax_unit_short, default=10.0) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) if (CS%mask_tracers) then @@ -138,7 +127,7 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This is needed to force the compiler not to do a copy in the registration calls. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for horizontal advection & diffusion. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., flux_units="kg/s", & restart_CS=restart_CS) @@ -153,13 +142,13 @@ end function register_RGC_tracer subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & layer_CSp, sponge_CSp) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. 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. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness, in m or kg m-2. + intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary @@ -170,9 +159,9 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & type(ALE_sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for the !! sponges, if they are in use. Otherwise this may be unassociated. - real, allocatable :: temp(:,:,:) + real, allocatable :: temp(:,:,:) ! A temporary array used for several sponge target values [various] character(len=16) :: name ! A variable's name in a NetCDF file. - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers in this module [kg kg-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m @@ -224,7 +213,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (nzdata>0) then allocate(temp(G%isd:G%ied,G%jsd:G%jed,nzdata)) do k=1,nzdata ; do j=js,je ; do i=is,ie - if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + if (G%geoLonT(i,j) >= (G%len_lon - CS%lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then temp(i,j,k) = 0.0 endif enddo ; enddo ; enddo @@ -240,7 +229,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & if (nz>0) then allocate(temp(G%isd:G%ied,G%jsd:G%jed,nz)) do k=1,nz ; do j=js,je ; do i=is,ie - if (G%geoLonT(i,j) >= (CS%lenlon - CS%lensponge) .AND. G%geoLonT(i,j) <= CS%lenlon) then + if (G%geoLonT(i,j) >= (G%len_lon - CS%lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then temp(i,j,k) = 0.0 endif enddo ; enddo ; enddo @@ -263,8 +252,8 @@ end subroutine initialize_RGC_tracer !! This is a simple example of a set of advected passive tracers. subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, 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. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -283,22 +272,20 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(RGC_tracer_CS), pointer :: CS !< The control structure returned by a previous call. 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]. + !! 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]. + !! can be applied [H ~> m or kg m-2]. ! 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] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real :: in_flux(SZI_(G),SZJ_(G),2) ! total amount of tracer to be injected integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return - in_flux(:,:,:) = 0.0 m=1 do j=js,je ; do i=is,ie ! set tracer to 1.0 in the surface of the continental shelf @@ -313,7 +300,7 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, 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, in_flux(:,:,m)) + evap_CFL_limit, minimum_forcing_depth) call tracer_vertdiff(h_work, ea, eb, dt, CS%tr(:,:,:,m), G, GV) enddo diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 5e43ce5757..d8eb4d57fb 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -3,25 +3,25 @@ module advection_test_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coms, only : EFP_type -use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux -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 : slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS -use MOM_spatial_means, only : global_mass_int_EFP -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_coms, only : EFP_type +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux +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 : slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -40,16 +40,16 @@ module advection_test_tracer character(len=200) :: tracer_IC_file !< The full path to the IC file, or " " to initialize internally. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? - real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine [conc] + real :: land_val(NTR) = -1.0 !< The value of tr used where land is masked out [conc] logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. logical :: tracers_may_reinit !< If true, the tracers may be set up via the initialization code if !! they are not found in the restart files. Otherwise it is a fatal error !! if the tracers are not found in the restart files of a restarted run. - real :: x_origin !< Parameters describing the test functions - real :: x_width !< Parameters describing the test functions - real :: y_origin !< Parameters describing the test functions - real :: y_width !< Parameters describing the test functions + real :: x_origin !< Starting x-position of the tracer [m] or [km] or [degrees_E] + real :: x_width !< Initial size in the x-direction of the tracer patch [m] or [km] or [degrees_E] + real :: y_origin !< Starting y-position of the tracer [m] or [km] or [degrees_N] + real :: y_width !< Initial size in the y-direction of the tracer patch [m] or [km] or [degrees_N] integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and !! the surface tracer concentrations are to be provided to the coupler. @@ -64,8 +64,8 @@ module advection_test_tracer contains !> Register tracer fields and subroutines to be used with MOM. -function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure +function register_advection_test_tracer(G, GV, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous @@ -80,13 +80,13 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "advection_test_tracer" ! This module's name. - character(len=200) :: inputdir + character(len=200) :: inputdir ! The directory where the input file can be found 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 a tracer array [conc] logical :: register_advection_test_tracer integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "register_advection_test_tracer called with an "// & @@ -98,13 +98,13 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "ADVECTION_TEST_X_ORIGIN", CS%x_origin, & - "The x-coordinate of the center of the test-functions.", units="same as geoLon", default=0.) + "The x-coordinate of the center of the test-functions.", units=G%x_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_Y_ORIGIN", CS%y_origin, & - "The y-coordinate of the center of the test-functions.", units="same as geoLat", default=0.) + "The y-coordinate of the center of the test-functions.", units=G%y_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_X_WIDTH", CS%x_width, & - "The x-width of the test-functions.", units="same as geoLon", default=0.) + "The x-width of the test-functions.", units=G%x_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_Y_WIDTH", CS%y_width, & - "The y-width of the test-functions.", units="same as geoLat", default=0.) + "The y-width of the test-functions.", units=G%y_ax_unit_short, default=0.) call get_param(param_file, mdl, "ADVECTION_TEST_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial "//& "conditions for the tracers, or blank to initialize "//& @@ -143,7 +143,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ ! 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, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., flux_units=flux_units, & restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit) @@ -181,12 +181,13 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS type(sponge_CS), pointer :: sponge_CSp !< Pointer to the control structure for the sponges. ! Local variables - character(len=16) :: name ! A variable's name in a NetCDF file. + character(len=16) :: name ! A variable's name in a NetCDF file. + real :: locx, locy ! x- and y- positions relative to the center of the tracer patch + ! normalized by its size [nondim] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB - real :: locx, locy if (.not.associated(CS)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -211,28 +212,28 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS enddo ; enddo k=2 ! Triangle wave do j=js,je ; do i=is,ie - locx=abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width - locy=abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width + locx = abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width + locy = abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width CS%tr(i,j,k,m) = max(0.0, 1.0-locx)*max(0.0, 1.0-locy) enddo ; enddo k=3 ! Cosine bell do j=js,je ; do i=is,ie - locx=min(1.0, abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width)*(acos(0.0)*2.) - locy=min(1.0, abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width)*(acos(0.0)*2.) + locx = min(1.0, abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width) * (acos(0.0)*2.) + locy = min(1.0, abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width) * (acos(0.0)*2.) CS%tr(i,j,k,m) = (1.0+cos(locx))*(1.0+cos(locy))*0.25 enddo ; enddo k=4 ! Cylinder do j=js,je ; do i=is,ie - locx=abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width - locy=abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width + locx = abs(G%geoLonT(i,j)-CS%x_origin)/CS%x_width + locy = abs(G%geoLatT(i,j)-CS%y_origin)/CS%y_width if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0 enddo ; enddo k=5 ! Cut cylinder do j=js,je ; do i=is,ie - locx=(G%geoLonT(i,j)-CS%x_origin)/CS%x_width - locy=(G%geoLatT(i,j)-CS%y_origin)/CS%y_width + locx = (G%geoLonT(i,j)-CS%x_origin)/CS%x_width + locy = (G%geoLatT(i,j)-CS%y_origin)/CS%y_width if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0 - if (locx>0.0.and.abs(locy)<0.2) CS%tr(i,j,k,m) = 0.0 + if (locx>0.0 .and. abs(locy)<0.2) CS%tr(i,j,k,m) = 0.0 enddo ; enddo call set_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp) diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index a7066c1ab8..2a3727bdca 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -98,7 +98,7 @@ function register_boundary_impulse_tracer(HI, GV, US, param_file, CS, tr_Reg, re "Length of time for the boundary tracer to be injected "//& "into the mixed layer. After this time has elapsed, the "//& "surface becomes a sink for the boundary impulse tracer.", & - default=31536000.0, scale=US%s_to_T) + units="s", default=31536000.0, scale=US%s_to_T) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code "//& "if they are not found in the restart files. Otherwise "//& diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 1aae1d3367..fbc2b28a95 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -41,14 +41,18 @@ module regional_dyes type, public :: dye_tracer_CS ; private integer :: ntr !< The number of tracers that are actually used. logical :: coupled_tracers = .false. !< These tracers are not offered to the coupler. - real, allocatable, dimension(:) :: dye_source_minlon !< Minimum longitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be injected. - real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be injected. + real, allocatable, dimension(:) :: dye_source_minlon !< Minimum longitude of region dye will be + !! injected, in [m] or [km] or [degrees_E] + real, allocatable, dimension(:) :: dye_source_maxlon !< Maximum longitude of region dye will be + !! injected, in [m] or [km] or [degrees_E] + real, allocatable, dimension(:) :: dye_source_minlat !< Minimum latitude of region dye will be + !! injected, in [m] or [km] or [degrees_N] + real, allocatable, dimension(:) :: dye_source_maxlat !< Maximum latitude of region dye will be + !! injected, in [m] or [km] or [degrees_N] real, allocatable, dimension(:) :: dye_source_mindepth !< Minimum depth of region dye will be injected [Z ~> m]. real, allocatable, dimension(:) :: dye_source_maxdepth !< Maximum depth of region dye will be injected [Z ~> m]. 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 subroutine, in g m-3? + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine [CU ~> conc] integer, allocatable, dimension(:) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the !! surface tracer concentrations are to be provided to the coupler. @@ -74,7 +78,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) !! structure for this module 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), target, intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control structure ! Local variables character(len=40) :: mdl = "regional_dyes" ! This module's name. @@ -82,7 +86,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) character(len=48) :: desc_name ! The variable's descriptor. ! This include declares and sets the variable "version". # include "version_variable.h" - real, pointer :: tr_ptr(:,:,:) => NULL() + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers [CU ~> conc] logical :: register_dye_tracer integer :: isd, ied, jsd, jed, nz, m isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -110,28 +114,32 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%dye_source_minlon(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINLON", CS%dye_source_minlon, & "This is the starting longitude at which we start injecting dyes.", & - fail_if_missing=.true.) + units="degrees_E", fail_if_missing=.true.) + ! units=G%x_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_minlon(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLON ") CS%dye_source_maxlon(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXLON", CS%dye_source_maxlon, & "This is the ending longitude at which we finish injecting dyes.", & - fail_if_missing=.true.) + units="degrees_E", fail_if_missing=.true.) + ! units=G%x_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_maxlon(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLON ") CS%dye_source_minlat(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MINLAT", CS%dye_source_minlat, & "This is the starting latitude at which we start injecting dyes.", & - fail_if_missing=.true.) + units="degrees_N", fail_if_missing=.true.) + ! units=G%y_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_minlat(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLAT ") CS%dye_source_maxlat(:) = -1.e30 call get_param(param_file, mdl, "DYE_SOURCE_MAXLAT", CS%dye_source_maxlat, & "This is the ending latitude at which we finish injecting dyes.", & - fail_if_missing=.true.) + units="degrees_N", fail_if_missing=.true.) + ! units=G%y_ax_unit_short, fail_if_missing=.true.) if (minval(CS%dye_source_maxlat(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLAT ") @@ -211,10 +219,10 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C do m= 1, CS%ntr do j=G%jsd,G%jed ; do i=G%isd,G%ied ! A dye is set dependent on the center of the cell being inside the rectangular box. - if (CS%dye_source_minlon(m)=G%geoLonT(i,j) .and. & - CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & + if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. & + CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. & + CS%dye_source_minlat(m) < G%geoLatT(i,j) .and. & + CS%dye_source_maxlat(m) >= G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then z_bot = 0.0 do k = 1, GV%ke @@ -264,7 +272,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US !! fluxes can be applied [H ~> m or kg m-2] ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] integer :: i, j, k, is, ie, js, je, nz, m @@ -292,10 +300,10 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US do m=1,CS%ntr do j=G%jsd,G%jed ; do i=G%isd,G%ied ! A dye is set dependent on the center of the cell being inside the rectangular box. - if (CS%dye_source_minlon(m)=G%geoLonT(i,j) .and. & - CS%dye_source_minlat(m)=G%geoLatT(i,j) .and. & + if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. & + CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. & + CS%dye_source_minlat(m) < G%geoLatT(i,j) .and. & + CS%dye_source_maxlat(m) >= G%geoLatT(i,j) .and. & G%mask2dT(i,j) > 0.0 ) then z_bot = 0.0 do k=1,nz diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index aa365b1c6d..71800284a6 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -126,10 +126,10 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) "found in the restart files of a restarted run.", & default=.false.) call get_param(param_file, mdl, "OIL_SOURCE_LONGITUDE", CS%oil_source_longitude, & - "The geographic longitude of the oil source.", units="degrees E", & + "The geographic longitude of the oil source.", units="degrees_E", & fail_if_missing=.true.) call get_param(param_file, mdl, "OIL_SOURCE_LATITUDE", CS%oil_source_latitude, & - "The geographic latitude of the oil source.", units="degrees N", & + "The geographic latitude of the oil source.", units="degrees_N", & fail_if_missing=.true.) call get_param(param_file, mdl, "OIL_SOURCE_LAYER", CS%oil_source_k, & "The layer into which the oil is introduced, or a "//& @@ -165,7 +165,8 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) endif endif enddo - call log_param(param_file, mdl, "OIL_DECAY_RATE", US%s_to_T*CS%oil_decay_rate(1:CS%ntr)) + call log_param(param_file, mdl, "OIL_DECAY_RATE", CS%oil_decay_rate(1:CS%ntr), & + units="s-1", unscale=US%s_to_T) ! This needs to be changed if the units of tracer are changed above. if (GV%Boussinesq) then ; flux_units = "kg s-1" @@ -362,7 +363,7 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then decay_timescale = (12.0 * (3.0**(-(tv%T(i,j,k)-20.0*US%degC_to_C)/10.0*US%degC_to_C))) * & - (86400.0*US%s_to_T) ! Timescale [s ~> T] + (86400.0*US%s_to_T) ! Timescale [T ~> s] ldecay = 1. / decay_timescale ! Rate [T-1 ~> s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*ldecay,0.)*CS%tr(i,j,k,m) endif diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 335f82a59b..fa9b978f9c 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -39,8 +39,13 @@ module USER_tracer_example !! to initialize internally. 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 subroutine, in g m-3? - real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, perhaps in [g kg-1]? + real :: land_val(NTR) = -1.0 !< The value of tr that is used where land is masked out, perhaps in [g kg-1]? + + real :: stripe_width !< The Gaussian width of the stripe in the initial condition + !! for the tracer_example tracers [L ~> m] + real :: stripe_lat !< The central latitude of the stripe in the initial condition + !! for the tracer_example tracers, in [degrees_N] or [km] or [m]. logical :: use_sponge !< If true, sponges may be applied somewhere in the domain. integer, dimension(NTR) :: ind_tr !< Indices returned by atmos_ocn_coupler_flux if it is used and the @@ -54,16 +59,17 @@ module USER_tracer_example contains !> This subroutine is used to register tracer fields and subroutines to be used with MOM. -function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI !< A horizontal index type structure +function USER_register_tracer_example(G, GV, US, param_file, CS, tr_Reg, restart_CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(USER_tracer_example_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module 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), intent(inout) :: restart_CS !< MOM restart control struct + type(MOM_restart_CS), intent(inout) :: restart_CS !< MOM restart control struct ! Local variables character(len=80) :: name, longname @@ -73,10 +79,10 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS character(len=200) :: inputdir 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 one of the tracers, perhaps in [g kg-1] logical :: USER_register_tracer_example integer :: isd, ied, jsd, jed, nz, m - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke if (associated(CS)) then call MOM_error(FATAL, "USER_register_tracer_example called with an "// & @@ -87,9 +93,9 @@ function USER_register_tracer_example(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, "") call get_param(param_file, mdl, "TRACER_EXAMPLE_IC_FILE", CS%tracer_IC_file, & - "The name of a file from which to read the initial "//& - "conditions for the DOME tracers, or blank to initialize "//& - "them internally.", default=" ") + "The name of a file from which to read the initial conditions for "//& + "the tracer_example tracers, or blank to initialize them internally.", & + default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%tracer_IC_file = trim(slasher(inputdir))//trim(CS%tracer_IC_file) @@ -100,6 +106,12 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS "If true, sponges may be applied anywhere in the domain. "//& "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) + call get_param(param_file, mdl, "TRACER_EXAMPLE_STRIPE_WIDTH", CS%stripe_width, & + "The Gaussian width of the stripe in the initial condition for the "//& + "tracer_example tracers.", units="m", default=1.0e5, scale=US%m_to_L) + call get_param(param_file, mdl, "TRACER_EXAMPLE_STRIPE_LAT", CS%stripe_lat, & + "The central latitude of the stripe in the initial condition for the "//& + "tracer_example tracers.", units=G%y_ax_unit_short, default=40.0) allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) @@ -113,11 +125,10 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS if (GV%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1" else ; flux_units = "kg s-1" ; endif - ! This is needed to force the compiler not to do a copy in the registration - ! calls. Curses on the designers and implementers of Fortran90. + ! This pointer is needed to force the compiler not to do a copy in the registration calls. 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, & + call register_tracer(tr_ptr, tr_Reg, param_file, G%HI, GV, & name=name, longname=longname, units="kg kg-1", & registry_diags=.true., flux_units=flux_units, & restart_CS=restart_CS) @@ -157,11 +168,11 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & !! for the sponges, if they are in use. ! Local variables - real, allocatable :: temp(:,:,:) + real, allocatable :: temp(:,:,:) ! Target values for the tracers in the sponges, perhaps in [g kg-1] character(len=32) :: name ! A variable's name in a NetCDF file. - real, pointer :: tr_ptr(:,:,:) => NULL() - real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: tr_y ! Initial zonally uniform tracer concentrations. + real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] + real :: tr_y ! Initial zonally uniform tracer concentrations, perhaps in [g kg-1] real :: dist2 ! The distance squared from a line [L2 ~> m2]. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m integer :: IsdB, IedB, JsdB, JedB, lntr @@ -195,9 +206,8 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! This sets a stripe of tracer across the basin. PI = 4.0*atan(1.0) do j=js,je - dist2 = (G%Rad_Earth_L * PI / 180.0)**2 * & - (G%geoLatT(i,j) - 40.0) * (G%geoLatT(i,j) - 40.0) - tr_y = 0.5 * exp( -dist2 / (1.0e5*US%m_to_L)**2 ) + dist2 = (G%Rad_Earth_L * PI / 180.0)**2 * (G%geoLatT(i,j) - CS%stripe_lat)**2 + tr_y = 0.5 * exp( -dist2 / CS%stripe_width**2 ) do k=1,nz ; do i=is,ie ! This adds the stripes of tracer to every layer. @@ -218,7 +228,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & allocate(temp(G%isd:G%ied,G%jsd:G%jed,nz)) do k=1,nz ; do j=js,je ; do i=is,ie - if (G%geoLatT(i,j) > 700.0 .and. (k > nz/2)) then + if ((G%geoLatT(i,j) > 0.5*G%len_lat + G%south_lat) .and. (k > nz/2)) then temp(i,j,k) = 1.0 else temp(i,j,k) = 0.0 @@ -227,8 +237,7 @@ subroutine USER_initialize_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & ! do m=1,NTR do m=1,1 - ! This is needed to force the compiler not to do a copy in the sponge - ! calls. Curses on the designers and implementers of Fortran90. + ! This pointer is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) call set_up_sponge_field(temp, tr_ptr, G, GV, nz, sponge_CSp) enddo @@ -288,28 +297,25 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, real :: d1(SZI_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. - real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. + real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. + real :: diapyc_filt ! A multiplicative filter that can be set to 0 to disable diapycnal + ! advection of the tracer [nondim] + real :: dye_up ! The tracer concentration of upwelled water, perhaps in [g kg-1]? + real :: dye_down ! The tracer concentration of downwelled water, perhaps in [g kg-1]? integer :: i, j, k, is, ie, js, je, nz, m -! The following array (trdc) determines the behavior of the tracer -! diapycnal advection. The first element is 1 if tracers are -! passively advected. The second and third are the concentrations -! to which downwelling and upwelling water are set, respectively. -! For most (normal) tracers, the appropriate vales are {1,0,0}. - - real :: trdc(3) -! Uncomment the following line to dye both upwelling and downwelling. -! data trdc / 0.0,1.0,1.0 / -! Uncomment the following line to dye downwelling. -! data trdc / 0.0,1.0,0.0 / -! Uncomment the following line to dye upwelling. -! data trdc / 0.0,0.0,1.0 / -! Uncomment the following line for tracer concentrations to be set -! to zero in any diapycnal motions. -! data trdc / 0.0,0.0,0.0 / -! Uncomment the following line for most "physical" tracers, which -! are advected diapycnally in the usual manner. - data trdc / 1.0,0.0,0.0 / + ! These are the settings for most "physical" tracers, which + ! are advected diapycnally in the usual manner. + diapyc_filt = 1.0 ; dye_down = 0.0 ; dye_down = 0.0 + + ! Uncomment the following line to dye downwelling. +! diapyc_filt = 0.0 ; dye_down = 1.0 + ! Uncomment the following line to dye upwelling. +! diapyc_filt = 0.0 ; dye_up = 1.0 + ! Uncomment the following line for tracer concentrations to be set + ! to zero in any diapycnal motions. +! diapyc_filt = 0.0 ; dye_down = 0.0 ; dye_down = 0.0 + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return @@ -330,21 +336,21 @@ subroutine tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, b_denom_1 = h_old(i,j,1) + ea(i,j,1) + h_neglect b1(i) = 1.0 / (b_denom_1 + eb(i,j,1)) ! d1(i) = b_denom_1 * b1(i) - d1(i) = trdc(1) * (b_denom_1 * b1(i)) + (1.0 - trdc(1)) + d1(i) = diapyc_filt * (b_denom_1 * b1(i)) + (1.0 - diapyc_filt) do m=1,NTR - CS%tr(i,j,1,m) = b1(i)*(hold0(i)*CS%tr(i,j,1,m) + trdc(3)*eb(i,j,1)) + CS%tr(i,j,1,m) = b1(i)*(hold0(i)*CS%tr(i,j,1,m) + dye_up*eb(i,j,1)) ! Add any surface tracer fluxes to the preceding line. enddo enddo do k=2,nz ; do i=is,ie - c1(i,k) = trdc(1) * eb(i,j,k-1) * b1(i) + c1(i,k) = diapyc_filt * eb(i,j,k-1) * b1(i) b_denom_1 = h_old(i,j,k) + d1(i)*ea(i,j,k) + h_neglect b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) - d1(i) = trdc(1) * (b_denom_1 * b1(i)) + (1.0 - trdc(1)) + d1(i) = diapyc_filt * (b_denom_1 * b1(i)) + (1.0 - diapyc_filt) do m=1,NTR CS%tr(i,j,k,m) = b1(i) * (h_old(i,j,k)*CS%tr(i,j,k,m) + & - ea(i,j,k)*(trdc(1)*CS%tr(i,j,k-1,m)+trdc(2)) + & - eb(i,j,k)*trdc(3)) + ea(i,j,k)*(diapyc_filt*CS%tr(i,j,k-1,m) + dye_down) + & + eb(i,j,k)*dye_up) enddo enddo ; enddo do m=1,NTR ; do k=nz-1,1,-1 ; do i=is,ie diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 68a6b6530b..3efc908ffb 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -24,10 +24,6 @@ module BFB_initialization ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -!> Unsafe model variable -!! \todo Remove this module variable -logical :: first_call = .true. - contains !> This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. @@ -42,17 +38,22 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - real :: drho_dt, SST_s, T_bot, rho_top, rho_bot - integer :: k, nz - character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name. + real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: SST_s, T_bot ! Temperatures at the surface and seafloor [C ~> degC] + real :: rho_top, rho_bot ! Densities at the surface and seafloor [R ~> kg m-3] + integer :: k, nz + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "BFB_initialization" ! This module's name. + call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "DRHO_DT", drho_dt, & "Rate of change of density with temperature.", & - units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R) + units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC) call get_param(param_file, mdl, "SST_S", SST_s, & - "SST at the suothern edge of the domain.", units="C", default=20.0) + "SST at the southern edge of the domain.", units="degC", default=20.0, scale=US%degC_to_C) call get_param(param_file, mdl, "T_BOT", T_bot, & - "Bottom Temp", units="C", default=5.0) + "Bottom temperature", units="degC", default=5.0, scale=US%degC_to_C) rho_top = GV%Rho0 + drho_dt*SST_s rho_bot = GV%Rho0 + drho_dt*T_bot nz = GV%ke @@ -64,15 +65,11 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, US, param_file) else g_prime(k) = GV%g_Earth endif - !Rlay(:) = 0.0 - !g_prime(:) = 0.0 enddo - if (first_call) call write_BFB_log(param_file) - end subroutine BFB_set_coord -!> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs +!> This subroutine sets up the sponges for the southern boundary 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, depth_tot, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -92,29 +89,27 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for eta, in depth units [Z ~> m]. real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: H0(SZK_(GV)) ! Resting layer thicknesses in depth units [Z ~> m]. - real :: min_depth ! The minimum ocean depth in depth units [Z ~> m]. real :: slat ! The southern latitude of the domain [degrees_N] real :: wlon ! The western longitude of the domain [degrees_E] real :: lenlat ! The latitudinal length of the domain [degrees_N] real :: lenlon ! The longitudinal length of the domain [degrees_E] real :: nlat ! The northern latitude of the domain [degrees_N] real :: max_damping ! The maximum damping rate [T-1 ~> s-1] + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz 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 - eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 - ! Here the inverse damping time [T-1 ~> s-1], is set. Set Idamp to 0 ! wherever there is no sponge, and the subroutines that are called ! will automatically set up the sponges only where Idamp is positive ! and mask2dT is 1. -! Set up sponges for DOME configuration - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) + ! Set up sponges for this configuration + ! call log_version(param_file, mdl, version) slat = G%south_lat lenlat = G%len_lat @@ -124,12 +119,14 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo ! Use for meridional thickness profile initialization -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo + ! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo max_damping = 1.0 / (86400.0*US%s_to_T) + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 + do j=js,je ; do i=is,ie - if (depth_tot(i,j) <= min_depth) then ; Idamp(i,j) = 0.0 + if (G%mask2dT(i,j) <= 0.0) 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 @@ -140,16 +137,16 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept ! depth space for Boussinesq or non-Boussinesq models. ! This section is used for uniform thickness initialization - do k = 1,nz; eta(i,j,k) = H0(k); enddo + do k=1,nz ; eta(i,j,k) = H0(k) ; enddo - ! The below section is used for meridional temperature profile thickness initiation - ! do k = 1,nz; eta(i,j,k) = H0(k); enddo + ! The below section is used for meridional temperature profile thickness initialization + ! do k=1,nz ; eta(i,j,k) = H0(k) ; enddo ! if (G%geoLatT(i,j) > 40.0) then ! do k = 1,nz ! eta(i,j,k) = -G%Angstrom_Z*(k-1) ! enddo ! elseif (G%geoLatT(i,j) > 20.0) then - ! do k = 1,nz + ! do k=1,nz ! eta(i,j,k) = min(H0(k) + (G%geoLatT(i,j) - 20.0)*(G%max_depth - nz*G%Angstrom_Z)/20.0, & ! -(k-1)*G%Angstrom_Z) ! enddo @@ -166,23 +163,6 @@ subroutine BFB_initialize_sponges_southonly(G, GV, US, use_temperature, tv, dept ! By default, momentum is advected vertically within the sponge, but ! ! momentum is typically not damped within the sponge. ! - if (first_call) call write_BFB_log(param_file) - end subroutine BFB_initialize_sponges_southonly -!> Write output about the parameter values being used. -subroutine write_BFB_log(param_file) - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. - -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "BFB_initialization" ! This module's name. - - call log_version(param_file, mdl, version) - first_call = .false. - -end subroutine write_BFB_log - end module BFB_initialization diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 6f16bdd6f0..f3d04980f6 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -31,8 +31,8 @@ module BFB_surface_forcing real :: Flux_const !< The restoring rate at the surface [Z T-1 ~> m s-1]. real :: SST_s !< SST at the southern edge of the linear forcing ramp [C ~> degC] real :: SST_n !< SST at the northern edge of the linear forcing ramp [C ~> degC] - real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degLat] - real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degLat] + real :: lfrslat !< Southern latitude where the linear forcing ramp begins [degrees_N] or [km] + real :: lfrnlat !< Northern latitude where the linear forcing ramp ends [degrees_N] or [km] real :: drho_dt !< Rate of change of density with temperature [R C-1 ~> kg m-3 degC-1]. !! Note that temperature is being used as a dummy variable here. !! All temperatures are converted into density. @@ -197,7 +197,7 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) + units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -206,16 +206,16 @@ subroutine BFB_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "LFR_SLAT", CS%lfrslat, & "Southern latitude where the linear forcing ramp begins.", & - units="degrees", default=20.0) + units=G%y_ax_unit_short, default=20.0) call get_param(param_file, mdl, "LFR_NLAT", CS%lfrnlat, & "Northern latitude where the linear forcing ramp ends.", & - units="degrees", default=40.0) + units=G%y_ax_unit_short, default=40.0) call get_param(param_file, mdl, "SST_S", CS%SST_s, & "SST at the southern edge of the linear forcing ramp.", & - units="C", default=20.0, scale=US%degC_to_C) + units="degC", default=20.0, scale=US%degC_to_C) call get_param(param_file, mdl, "SST_N", CS%SST_n, & "SST at the northern edge of the linear forcing ramp.", & - units="C", default=10.0, scale=US%degC_to_C) + units="degC", default=10.0, scale=US%degC_to_C) call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, & "The rate of change of density with temperature.", & units="kg m-3 K-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC) diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a997cde26b..1382fe8e34 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -40,14 +40,18 @@ module DOME2d_initialization subroutine DOME2d_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables + real :: bay_depth ! Depth of shelf, as fraction of basin depth [nondim] + real :: l1, l2 ! Fractional horizontal positions where the slope changes [nondim] + real :: x ! Fractional horizontal positions [nondim] + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] integer :: i, j - real :: x, bay_depth, l1, l2 - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay ! This include declares and sets the variable "version". # include "version_variable.h" @@ -106,28 +110,30 @@ subroutine DOME2d_initialize_thickness ( h, depth_tot, G, GV, US, param_file, ju real :: e0(SZK_(GV)) ! The resting interface heights, in depth units [Z ~> m], usually ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface - ! positive upward, in depth units [Z ~> m]. - integer :: i, j, k, is, ie, js, je, nz - real :: x - real :: min_thickness - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + ! positive upward, in depth units [Z ~> m] + real :: x ! Fractional horizontal positions [nondim] + real :: min_thickness ! Minimum layer thicknesses [Z ~> m] + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] character(len=40) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.just_read) & call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + call get_param(param_file, mdl,"MIN_THICKNESS", min_thickness, & default=1.e-3, units="m", do_not_log=.true., scale=US%m_to_Z) call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & - default=0.1, do_not_log=.true.) + units="nondim", default=0.1, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & - default=0.3, do_not_log=.true.) + units="nondim", default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & - default=0.2, do_not_log=.true.) + units="nondim", default=0.2, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -229,34 +235,43 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. - integer :: i, j, k, is, ie, js, je, nz - real :: x - integer :: index_bay_z - real :: delta_S - real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer - real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical - real :: xi0, xi1 + real :: x ! Fractional horizontal positions [nondim] + real :: delta_S ! Change in salinity between layers [S ~> ppt] + real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer + real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical + real :: S_surf ! Initial surface salinity [S ~> ppt] + real :: T_bay ! Temperature in the inflow embayment [C ~> degC] + real :: xi0, xi1 ! Fractional vertical positions [nondim] + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] character(len=40) :: verticalCoordinate - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + integer :: index_bay_z + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & - default=0.1, do_not_log=.true.) + units="nondim", default=0.1, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & - default=0.3, do_not_log=.true.) + units="nondim", default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & - default=0.2, do_not_log=.true.) + units="nondim", default=0.2, do_not_log=.true.) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & - default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) + units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_RANGE", S_range,' Initial salinity range', & - units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) + units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, "Initial surface salinity", & + units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "DOME2D_T_BAY", T_bay, & + "Temperature in the inflow embayment in the DOME2d test case", & + units="degC", default=1.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -273,7 +288,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi xi0 = 0.0 do k = 1,nz xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth - S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo enddo ; enddo @@ -284,12 +299,12 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi xi0 = 0.0 do k = 1,nz xi1 = xi0 + (GV%H_to_Z * h(i,j,k)) / G%max_depth - S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,nz) = 34.0*US%ppt_to_S + S_range + S(i,j,nz) = S_surf + S_range endif enddo ; enddo @@ -314,7 +329,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then S(i,j,1:index_bay_z) = S_ref + S_range ! Use for z coordinates - T(i,j,1:index_bay_z) = 1.0*US%degC_to_C ! Use for z coordinates + T(i,j,1:index_bay_z) = T_bay ! Use for z coordinates endif enddo ; enddo ! i and j loops endif ! Z initial conditions @@ -324,8 +339,8 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - S(i,j,1:GV%ke) = S_ref + S_range ! Use for sigma coordinates - T(i,j,1:GV%ke) = 1.0*US%degC_to_C ! Use for sigma coordinates + S(i,j,1:GV%ke) = S_ref + S_range ! Use for sigma coordinates + T(i,j,1:GV%ke) = T_bay ! Use for sigma coordinates endif enddo ; enddo endif @@ -336,7 +351,7 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, GV, US, param_fi do i = G%isc,G%iec ; do j = G%jsc,G%jec x = ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon if ( x <= dome2d_width_bay ) then - T(i,j,GV%ke) = 1.0*US%degC_to_C + T(i,j,GV%ke) = T_bay endif enddo ; enddo endif @@ -365,15 +380,23 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A real :: T_ref ! Reference temperature within the surface layer [C ~> degC] real :: S_range ! Range of salinities in the vertical [S ~> ppt] real :: T_range ! Range of temperatures in the vertical [C ~> degC] + real :: S_range_sponge ! Range of salinities in the vertical in the east sponge [S ~> ppt] + real :: S_surf ! Initial surface salinity [S ~> ppt] real :: e0(SZK_(GV)+1) ! The resting interface heights [Z ~> m], ! usually negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: d_eta(SZK_(GV)) ! The layer thickness in a column [Z ~> m]. - real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + real :: dome2d_width_bay ! Width of shelf, as fraction of domain [nondim] + real :: dome2d_width_bottom ! Width of deep ocean basin, as fraction of domain [nondim] + real :: dome2d_depth_bay ! Depth of shelf, as fraction of basin depth [nondim] real :: dome2d_west_sponge_time_scale, dome2d_east_sponge_time_scale ! Sponge timescales [T ~> s] - real :: dome2d_west_sponge_width, dome2d_east_sponge_width - real :: dummy1, x, z + real :: dome2d_west_sponge_width ! The fraction of the domain in which the western sponge for + ! restoring T/S is active [nondim] + real :: dome2d_east_sponge_width ! The fraction of the domain in which the eastern sponge for + ! restoring T/S is active [nondim] + real :: dummy1, x ! Nondimensional local variables indicating horizontal positions [nondim] + real :: z ! Vertical positions [Z ~> m] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -405,16 +428,20 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A "DOME2d_initialize_sponges called with an associated ALE-sponge control structure.") call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & - default=0.1, do_not_log=.true.) + units="nondim", default=0.1, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & - default=0.3, do_not_log=.true.) + units="nondim", default=0.3, do_not_log=.true.) call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & - default=0.2, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, scale=US%ppt_to_S) - call get_param(param_file, mdl, "T_REF", T_ref, scale=US%degC_to_C, fail_if_missing=.false.) - call get_param(param_file, mdl, "S_RANGE", S_range, default=2.0, scale=US%ppt_to_S) - call get_param(param_file, mdl, "T_RANGE", T_range, default=0.0, scale=US%degC_to_C) - + units="nondim", default=0.2, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, units="ppt", default=35.0, scale=US%ppt_to_S) + call get_param(param_file, mdl, "T_REF", T_ref, units="degC", scale=US%degC_to_C, fail_if_missing=.false.) + call get_param(param_file, mdl, "S_RANGE", S_range, units="ppt", default=2.0, scale=US%ppt_to_S) + call get_param(param_file, mdl, "T_RANGE", T_range, units="degC", default=0.0, scale=US%degC_to_C) + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, "Initial surface salinity", & + units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "DOME2D_EAST_SPONGE_S_RANGE", S_range_sponge, & + "Range of salinities in the eastern sponge region in the DOME2D configuration", & + units="1e-3", default=1.0, scale=US%ppt_to_S) ! Set the sponge damping rate as a function of position Idamp(:,:) = 0.0 @@ -440,7 +467,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A if (use_ALE) then - ! Construct a grid (somewhat arbitrarily) to describe the sponge T/S on + ! Construct a grid (somewhat arbitrarily) to describe the sponge T/S on do k=1,nz e0(k) = -G%max_depth * ( real(k-1) / real(nz) ) enddo @@ -466,7 +493,9 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A 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*US%ppt_to_S - 1.0*US%ppt_to_S * (z / (G%max_depth)) + ! Use salinity stratification in the eastern sponge. + S(i,j,k) = S_surf - S_range_sponge * (z / G%max_depth) + ! Use a constant salinity in the western sponge. if ( ( G%geoLonT(i,j) - G%west_lon ) / G%len_lon < dome2d_west_sponge_width ) & S(i,j,k) = S_ref + S_range z = z + 0.5 * GV%H_to_Z * h(i,j,k) ! Position of the interface k diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index e8a6ae713c..7f939ffef6 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -306,6 +306,8 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3]. + real :: S_ref ! A default value for salinities [S ~> ppt] + real :: T_light ! A first guess at the temperature of the lightest layer [C ~> degC] ! The following variables are used to set up the transport in the DOME example. real :: tr_0 ! The total integrated inflow transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: tr_k ! The integrated inflow transport of a layer [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -357,6 +359,13 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) "inflow properties.", units="s-1", default=f_0*US%s_to_T, scale=US%T_to_s) call get_param(PF, mdl, "DOME_INFLOW_LON", inflow_lon, & "The edge longitude of the DOME inflow.", units="km", default=1000.0) + if (associated(tv%S) .or. associated(tv%T)) then + call get_param(PF, mdl, "S_REF", S_ref, & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(PF, mdl, "DOME_T_LIGHT", T_light, & + "A first guess at the temperature of the lightest layer in the DOME test case.", & + units="degC", default=25.0, scale=US%degC_to_C) + endif if (.not.associated(OBC)) return @@ -413,16 +422,16 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, US, PF, tr_Reg) ! The inflow values of temperature and salinity also need to be set here if ! these variables are used. The following code is just a naive example. if (associated(tv%S)) then - ! In this example, all S inflows have values of 35 psu. + ! In this example, all S inflows have values given by S_ref. name = 'salt' call tracer_name_lookup(tr_Reg, tr_ptr, name) - call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_scalar=35.0*US%ppt_to_S, scale=US%ppt_to_S) + call register_segment_tracer(tr_ptr, PF, GV, segment, OBC_scalar=S_ref, scale=US%ppt_to_S) endif if (associated(tv%T)) then ! In this example, the T values are set to be consistent with the layer - ! target density and a salinity of 35 psu. This code is taken from + ! target density and a salinity of S_ref. This code is taken from ! USER_initialize_temp_sal. - pres(:) = tv%P_Ref ; S0(:) = 35.0*US%ppt_to_S ; T0(1) = 25.0*US%degC_to_C + pres(:) = tv%P_Ref ; S0(:) = S_ref ; T0(1) = T_light call calculate_density(T0(1), S0(1), pres(1), rho_guess(1), tv%eqn_of_state) call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, tv%eqn_of_state, (/1,1/) ) diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index aaededaa8c..bba357f490 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -48,19 +48,20 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: min_depth ! The minimum depth of the ocean [Z ~> m]. ! The following variables are used to set up the bathymetry in the ISOMIP example. - real :: bmax ! max depth of bedrock topography [Z ~> m] - real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] - real :: xbar ! characteristic along-flow length scale of the bedrock + real :: bmax ! maximum depth of bedrock topography [Z ~> m] + real :: b0, b2, b4, b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] + real :: xbar ! characteristic along-flow length scale of the bedrock [L ~> m] real :: dc ! depth of the trough compared with side walls [Z ~> m]. - real :: fc ! characteristic width of the side walls of the channel - real :: wc ! half-width of the trough - real :: ly ! domain width (across ice flow) - real :: bx, by ! dummy vatiables [Z ~> m]. - real :: xtil ! dummy vatiable - logical :: is_2D ! If true, use 2D setup -! This include declares and sets the variable "version". + real :: fc ! characteristic width of the side walls of the channel [L ~> m] + real :: wc ! half-width of the trough [L ~> m] + real :: ly ! domain width (across ice flow) [L ~> m] + real :: bx, by ! The x- and y- contributions to the bathymetric profiles at a point [Z ~> m] + real :: xtil ! x-positon normalized by the characteristic along-flow length scale [nondim] + real :: km_to_L ! The conversion factor from the axis units to L [L km-1 ~> 1e3] + logical :: is_2D ! If true, use a 2D setup + ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "ISOMIP_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed @@ -72,27 +73,39 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) - - ! The following variables should be transformed into runtime parameters? - bmax = 720.0*US%m_to_Z ; dc = 500.0*US%m_to_Z + call get_param(param_file, mdl, "ISOMIP_2D", is_2D, 'If true, use a 2D setup.', default=.false.) + call get_param(param_file, mdl, "ISOMIP_MAX_BEDROCK", bmax, & + "Maximum depth of bedrock topography in the ISOMIP configuration.", & + units="m", default=720.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "ISOMIP_TROUGH_DEPTH", dc, & + "Depth of the trough compared with side walls in the ISOMIP configuration.", & + units="m", default=500.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "ISOMIP_BEDROCK_LENGTH", xbar, & + "Characteristic along-flow length scale of the bedrock in the ISOMIP configuration.", & + units="m", default=300.0e3, scale=US%m_to_L) + call get_param(param_file, mdl, "ISOMIP_TROUGH_WIDTH", wc, & + "Half-width of the trough in the ISOMIP configuration.", & + units="m", default=24.0e3, scale=US%m_to_L) + call get_param(param_file, mdl, "ISOMIP_DOMAIN_WIDTH", ly, & + "Domain width (across ice flow) in the ISOMIP configuration.", & + units="m", default=80.0e3, scale=US%m_to_L) + call get_param(param_file, mdl, "ISOMIP_SIDE_WIDTH", fc, & + "Characteristic width of the side walls of the channel in the ISOMIP configuration.", & + units="m", default=4.0e3, scale=US%m_to_L) + + km_to_L = 1.0e3*US%m_to_L + + ! The following variables should be transformed into runtime parameters. b0 = -150.0*US%m_to_Z ; b2 = -728.8*US%m_to_Z ; b4 = 343.91*US%m_to_Z ; b6 = -50.57*US%m_to_Z - xbar = 300.0e3 ; fc = 4.0e3 ; wc = 24.0e3 ; ly = 80.0e3 - bx = 0.0 ; by = 0.0 ; xtil = 0.0 - if (is_2D) then do j=js,je ; do i=is,ie - ! 2D setup - xtil = G%geoLonT(i,j)*1.0e3/xbar - !xtil = 450*1.0e3/xbar + ! For the 2D setup take a slice through the middle of the domain + xtil = G%geoLonT(i,j)*km_to_L / xbar + !xtil = 450.*km_to_L / xbar bx = b0 + b2*xtil**2 + b4*xtil**4 + b6*xtil**6 - !by = (dc/(1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & - ! (dc/(1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) - ! slice at y = 40 km - by = (dc / (1.+exp(-2.*(40.0*1.0e3- ly/2. - wc)/fc))) + & - (dc / (1.+exp(2.*(40.0*1.0e3- ly/2. + wc)/fc))) + by = 2.0 * dc / (1.0 + exp(2.0*wc / fc)) D(i,j) = -max(bx+by, -bmax) if (D(i,j) > max_depth) D(i,j) = max_depth @@ -104,17 +117,17 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) ! 3D setup ! ===== TEST ===== !if (G%geoLonT(i,j)<500.) then - ! xtil = 500.*1.0e3/xbar + ! xtil = 500.*km_to_L / xbar !else - ! xtil = G%geoLonT(i,j)*1.0e3/xbar + ! xtil = G%geoLonT(i,j)*km_to_L / xbar !endif ! ===== TEST ===== - xtil = G%geoLonT(i,j)*1.0e3/xbar + xtil = G%geoLonT(i,j)*km_to_L / xbar bx = b0 + b2*xtil**2 + b4*xtil**4 + b6*xtil**6 - by = (dc / (1.+exp(-2.*(G%geoLatT(i,j)*1.0e3- ly/2. - wc)/fc))) + & - (dc / (1.+exp(2.*(G%geoLatT(i,j)*1.0e3- ly/2. + wc)/fc))) + by = (dc / (1.0 + exp(-2.*(G%geoLatT(i,j)*km_to_L - 0.5*ly - wc) / fc))) + & + (dc / (1.0 + exp(2.*(G%geoLatT(i,j)*km_to_L - 0.5*ly + wc) / fc))) D(i,j) = -max(bx+by, -bmax) if (D(i,j) > max_depth) D(i,j) = max_depth @@ -264,17 +277,12 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables - integer :: i, j, k, is, ie, js, je, nz, itt real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: xi0, xi1 ! Heights in depth units [Z ~> m]. real :: S_sur, S_bot ! Salinity at the surface and bottom [S ~> ppt] real :: T_sur, T_bot ! Temperature at the surface and bottom [C ~> degC] real :: dT_dz ! Vertical gradient of temperature [C Z-1 ~> degC m-1]. real :: dS_dz ! Vertical gradient of salinity [S Z-1 ~> ppt m-1]. - !character(len=256) :: mesg ! The text of an error message - character(len=40) :: verticalCoordinate - !real :: rho_tmp - logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. real :: T0(SZK_(GV)) ! A profile of temperatures [C ~> degC] real :: S0(SZK_(GV)) ! A profile of salinities [S ~> ppt] real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. @@ -283,7 +291,14 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U real :: pres(SZK_(GV)) ! An array of the reference pressure [R L2 T-2 ~> Pa]. (zero here) real :: drho_dT1 ! A prescribed derivative of density with temperature [R C-1 ~> kg m-3 degC-1] real :: drho_dS1 ! A prescribed derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. - real :: T_Ref, S_Ref + real :: T_ref ! Default value for other temperatures [C ~> degC] + real :: S_ref ! Default value for other salinities [S ~> ppt] + logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. + !real :: rho_tmp ! A temporary density used for debugging [R ~> kg m-3] + !character(len=256) :: mesg ! The text of an error message + character(len=40) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz, itt + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pres(:) = 0.0 @@ -343,8 +358,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, depth_tot, G, GV, U "A reference temperature used in initialization.", & units="degC", scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_Ref, & - "A reference salinity used in initialization.", units="PSU", & - default=35.0, scale=US%ppt_to_S, do_not_log=just_read) + "A reference salinity used in initialization.", & + units="PSU", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. ! write(mesg,*) 'read drho_dS, drho_dT', drho_dS1, drho_dT1 @@ -450,7 +465,8 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, real :: TNUDG ! Nudging time scale [T ~> s] real :: S_sur, S_bot ! Surface and bottom salinities in the sponge region [S ~> ppt] real :: T_sur, T_bot ! Surface and bottom temperatures in the sponge region [C ~> degC] - real :: t_ref, s_ref ! reference (default) T [degC] and S [ppt] + real :: T_ref ! Default value for other temperatures [C ~> degC] + real :: S_ref ! Default value for other salinities [S ~> ppt] real :: rho_sur, rho_bot ! Surface and bottom densities [R ~> kg m-3] real :: rho_range ! The range of densities [R ~> kg m-3] real :: dT_dz ! Vertical gradient of temperature [C Z-1 ~> degC m-1] @@ -460,9 +476,10 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m]. real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! A temporary array for interface heights [Z ~> m]. - real :: min_depth, dummy1 - real :: min_thickness, xi0 - !real :: rho_tmp + real :: min_depth ! The minimum depth of the ocean [Z ~> m] + real :: min_thickness ! The minimum layer thickness [Z ~> m] + real :: xi0 ! Interface heights in depth units [Z ~> m], usually negative. + !real :: rho_tmp ! A temporary density used for debugging [R ~> kg m-3] character(len=40) :: verticalCoordinate, filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir @@ -478,30 +495,30 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, call get_param(PF, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) - call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, "Nudging time scale for sponge layers (days)", & - default=0.0, scale=86400.0*US%s_to_T) + call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, "Nudging time scale for sponge layers", & + units="days", default=0.0, scale=86400.0*US%s_to_T) - call get_param(PF, mdl, "T_REF", t_ref, "Reference temperature", default=10.0, & - do_not_log=.true.) + call get_param(PF, mdl, "T_REF", T_ref, "Reference temperature", & + units="degC", default=10.0, scale=US%degC_to_C, do_not_log=.true.) - call get_param(PF, mdl, "S_REF", s_ref, "Reference salinity", default=35.0, & - do_not_log=.true.) + call get_param(PF, mdl, "S_REF", s_ref, "Reference salinity", & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, & "Surface salinity in sponge layer.", & - units="ppt", default=s_ref, scale=US%ppt_to_S) ! units="ppt") + units="ppt", default=US%S_to_ppt*S_ref, scale=US%ppt_to_S) call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, & "Bottom salinity in sponge layer.", & - units="ppt", default=s_ref, scale=US%ppt_to_S) ! units="ppt") + units="ppt", default=US%S_to_ppt*S_ref, scale=US%ppt_to_S) call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, & "Surface temperature in sponge layer.", & - units="degC", default=t_ref, scale=US%degC_to_C) + units="degC", default=US%C_to_degC*T_ref, scale=US%degC_to_C) call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, & "Bottom temperature in sponge layer.", & - units="degC", default=t_ref, scale=US%degC_to_C) + units="degC", default=US%C_to_degC*T_ref, scale=US%degC_to_C) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 !; RHO(:,:,:) = 0.0 @@ -523,8 +540,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, 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) - Idamp(i,j) = (1.0/TNUDG) * max(0.0,dummy1) + Idamp(i,j) = (1.0/TNUDG) * max(0.0, (G%geoLonT(i,j)-790.0) / (800.0-790.0)) else Idamp(i,j) = 0.0 endif diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 595736540e..88d0cbb482 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -16,7 +16,7 @@ module Kelvin_initialization use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_E use MOM_open_boundary, only : OBC_DIRECTION_S, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_registry_type -use MOM_unit_scaling, only : unit_scale_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type use MOM_time_manager, only : time_type, time_type_to_real @@ -35,13 +35,16 @@ module Kelvin_initialization !> Control structure for Kelvin wave open boundaries. type, public :: Kelvin_OBC_CS ; private integer :: mode = 0 !< Vertical mode - real :: coast_angle = 0 !< Angle of coastline [rad] - real :: coast_offset1 = 0 !< Longshore distance to coastal angle [L ~> m] - real :: coast_offset2 = 0 !< Longshore distance to coastal angle [L ~> m] - real :: H0 = 0 !< Bottom depth [Z ~> m] - real :: F_0 !< Coriolis parameter [T-1 ~> s-1] - real :: rho_range !< Density range [R ~> kg m-3] - real :: rho_0 !< Mean density [R ~> kg m-3] + real :: coast_angle = 0 !< Angle of coastline [rad] + real :: coast_offset1 = 0 !< Longshore distance to coastal angle [L ~> m] + real :: coast_offset2 = 0 !< Offshore distance to coastal angle [L ~> m] + real :: H0 = 0 !< Bottom depth [Z ~> m] + real :: F_0 !< Coriolis parameter [T-1 ~> s-1] + real :: rho_range !< Density range [R ~> kg m-3] + real :: rho_0 !< Mean density [R ~> kg m-3] + real :: wave_period !< Period of the mode-0 waves [T ~> s] + real :: ssh_amp !< Amplitude of the sea surface height forcing for mode-0 waves [Z ~> m] + real :: inflow_amp !< Amplitude of the boundary velocity forcing for internal waves [L T-1 ~> m s-1] end type Kelvin_OBC_CS ! This include declares and sets the variable "version". @@ -87,16 +90,28 @@ function register_Kelvin_OBC(param_file, CS, US, OBC_Reg) units="km", default=10.0, scale=1.0e3*US%m_to_L) call get_param(param_file, mdl, "ROTATED_COAST_ANGLE", CS%coast_angle, & "The angle of the southern bondary beyond X=ROTATED_COAST_OFFSET.", & - units="degrees", default=11.3) - CS%coast_angle = CS%coast_angle * (atan(1.0)/45.) ! Convert to radians + units="degrees", default=11.3, scale=atan(1.0)/45.) ! Convert to radians + else + CS%coast_offset1 = 0.0 ; CS%coast_offset2 = 0.0 ; CS%coast_angle = 0.0 endif - if (CS%mode /= 0) then + if (CS%mode == 0) then + call get_param(param_file, mdl, "KELVIN_WAVE_PERIOD", CS%wave_period, & + "The period of the Kelvin wave forcing at the open boundaries. "//& + "The default value is the M2 tide period.", & + units="s", default=12.42*3600.0, scale=US%s_to_T) + call get_param(param_file, mdl, "KELVIN_WAVE_SSH_AMP", CS%ssh_amp, & + "The amplitude of the Kelvin wave sea surface height anomaly forcing "//& + "at the open boundaries.", units="m", default=1.0, scale=US%m_to_Z) + else call get_param(param_file, mdl, "DENSITY_RANGE", CS%rho_range, & - default=2.0, do_not_log=.true., scale=US%kg_m3_to_R) + units="kg m-3", default=2.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "RHO_0", CS%rho_0, & - default=1035.0, do_not_log=.true., scale=US%kg_m3_to_R) + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "MAXIMUM_DEPTH", CS%H0, & - default=1000.0, do_not_log=.true., scale=US%m_to_Z) + units="m", default=1000.0, scale=US%m_to_Z, do_not_log=.true.) + call get_param(param_file, mdl, "KELVIN_WAVE_INFLOW_AMP", CS%inflow_amp, & + "The amplitude of the Kelvin wave sea surface inflow velocity forcing "//& + "at the open boundaries.", units="m s-1", default=1.0, scale=US%m_s_to_L_T) endif ! Register the Kelvin open boundary. @@ -126,8 +141,10 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. - real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: coast_offset1, coast_offset2, coast_angle, right_angle + real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: coast_angle ! Angle of coastline [rad] + real :: coast_offset1 ! Longshore distance to coastal angle [L ~> m] + real :: coast_offset2 ! Offshore distance to coastal angle [L ~> m] integer :: i, j call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) @@ -135,26 +152,23 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", coast_offset1, & - default=100.0, do_not_log=.true.) + units="km", default=100.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & - default=10.0, do_not_log=.true.) + units="km", default=10.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_ANGLE", coast_angle, & - default=11.3, do_not_log=.true.) - - coast_angle = coast_angle * (atan(1.0)/45.) ! Convert to radians - right_angle = 2 * atan(1.0) + units="degrees", default=11.3, scale=(atan(1.0)/45.), do_not_log=.true.) ! Convert to radians do j=G%jsc,G%jec ; do i=G%isc,G%iec D(i,j) = max_depth ! Southern side if ((G%geoLonT(i,j) - G%west_lon > coast_offset1) .AND. & (atan2(G%geoLatT(i,j) - G%south_lat + coast_offset2, & - G%geoLonT(i,j) - G%west_lon - coast_offset1) < coast_angle)) & + G%geoLonT(i,j) - G%west_lon - coast_offset1) < coast_angle)) & D(i,j) = 0.5*min_depth ! Northern side if ((G%geoLonT(i,j) - G%west_lon < G%len_lon - coast_offset1) .AND. & (atan2(G%len_lat + G%south_lat + coast_offset2 - G%geoLatT(i,j), & - G%len_lon + G%west_lon - coast_offset1 - G%geoLonT(i,j)) < coast_angle)) & + G%len_lon + G%west_lon - coast_offset1 - G%geoLonT(i,j)) < coast_angle)) & D(i,j) = 0.5*min_depth if (D(i,j) > max_depth) D(i,j) = max_depth @@ -181,10 +195,8 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) real :: N0 ! Brunt-Vaisala frequency times a rescaling of slopes [L Z-1 T-1 ~> s-1] real :: lambda ! Offshore decay scale [L-1 ~> m-1] real :: omega ! Wave frequency [T-1 ~> s-1] - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] 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] real :: mag_int ! An overall magnitude of the internal wave at the coastline [L2 T-2 ~> m2 s-2] real :: x1, y1 ! Various positions [L ~> m] @@ -194,6 +206,8 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) real :: km_to_L_scale ! A scaling factor from longitudes in km to L [L km-1 ~> 1e3] real :: sina, cosa ! The sine and cosine of the coast angle [nondim] type(OBC_segment_type), pointer :: segment => NULL() + integer :: i, j, k, n, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: IsdB, IedB, JsdB, JedB 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 @@ -214,11 +228,11 @@ subroutine Kelvin_set_OBC_data(OBC, CS, G, GV, US, h, Time) 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 + mag_SSH = CS%ssh_amp + omega = 2.0 * PI / CS%wave_period val1 = sin(omega * time_sec) else - mag_int = 1.0*US%m_s_to_L_T**2 + mag_int = CS%inflow_amp**2 N0 = sqrt((CS%rho_range / CS%rho_0) * (GV%g_Earth / CS%H0)) lambda = PI * CS%mode * CS%F_0 / (CS%H0 * N0) ! Two wavelengths in domain diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 24d370e920..d218b4ea80 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -270,8 +270,8 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec ! Accumulate the average anomalies for this period. dt_wt = wt_per1 * dt CS%avg_time(m_mid) = CS%avg_time(m_mid) + dt_wt - ! These loops temporarily change the units of the CS%avg_ variables to [degC T ~> degC s] - ! or [ppt T ~> ppt s]. + ! These loops temporarily change the units of the CS%avg_ variables to [C T ~> degC s] + ! or [S T ~> ppt s]. do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_mid) = CS%avg_SST_anom(i,j,m_mid) + & dt_wt * G%mask2dT(i,j) * SST_anom(i,j) @@ -397,7 +397,7 @@ end subroutine apply_ctrl_forcing !> This function maps rval into an integer in the range from 1 to num_period. function periodic_int(rval, num_period) result (m) - real, intent(in) :: rval !< Input for mapping. + real, intent(in) :: rval !< Input for mapping [nondim] integer, intent(in) :: num_period !< Maximum output. integer :: m !< Return value. @@ -412,9 +412,9 @@ function periodic_int(rval, num_period) result (m) !> This function shifts rval by an integer multiple of num_period so that !! 0 <= val_out < num_period. function periodic_real(rval, num_period) result(val_out) - real, intent(in) :: rval !< Input to be shifted into valid range. + real, intent(in) :: rval !< Input to be shifted into valid range [nondim] integer, intent(in) :: num_period !< Maximum valid value. - real :: val_out !< Return value. + real :: val_out !< Return value [nondim] integer :: nshft if (rval < 0) then ; nshft = floor(abs(rval) / num_period) + 1 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index a423ddc8b8..a548436329 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -20,7 +20,7 @@ module MOM_wave_interface use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, surface use MOM_verticalgrid, only : verticalGrid_type -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_pair, MOM_restart_CS implicit none ; private @@ -73,27 +73,27 @@ module MOM_wave_interface !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - ddt_Us_x !< 3d time tendency of zonal Stokes drift profile [m s-1] + ddt_Us_x !< 3d time tendency of zonal Stokes drift profile [L T-2 ~> m s-2] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - ddt_Us_y !< 3d time tendency of meridional Stokes drift profile [m s-1] + ddt_Us_y !< 3d time tendency of meridional Stokes drift profile [L T-2 ~> m s-2] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_x_from_ddt !< Check of 3d zonal Stokes drift profile [m s-1] + Us_x_from_ddt !< Check of 3d zonal Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [m s-1] + Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [L T-1 ~> m s-1] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [m s-1] + Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [L T-1 ~> m s-1] !! Horizontal -> U points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y_prev !< 3d meridional Stokes drift profile, previous dynamics call [m s-1] + Us_y_prev !< 3d meridional Stokes drift profile, previous dynamics call [L T-1 ~> m s-1] !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & @@ -107,24 +107,27 @@ module MOM_wave_interface !! 2 - DHH85 !! 3 - LF17 !! -99 - No waves computed, but empirical Langmuir number used. - logical :: LagrangianMixing !< This feature is in development and not ready - !! True if Stokes drift is present and mixing - !! should be applied to Lagrangian current - !! (mean current + Stokes drift). - !! See Reichl et al., 2016 KPP-LT approach - logical :: StokesMixing !< This feature is in development and not ready. - !! True if vertical mixing of momentum - !! should be applied directly to Stokes current - !! (with separate mixing parameter for Eulerian - !! mixing contribution). - !! See Harcourt 2013, 2015 Second-Moment approach - logical :: CoriolisStokes !< This feature is in development and not ready. - ! True if Coriolis-Stokes acceleration should be applied. - integer :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points - !! or layer averaged. Set to 0 if mid-point and set to - !! 1 if average value of Stokes drift over level. - !! If advecting with Stokes transport, 1 is the correct - !! approach. + logical :: LagrangianMixing !< This feature is in development and not ready + !! True if Stokes drift is present and mixing + !! should be applied to Lagrangian current + !! (mean current + Stokes drift). + !! See Reichl et al., 2016 KPP-LT approach + logical :: StokesMixing !< This feature is in development and not ready. + !! True if vertical mixing of momentum + !! should be applied directly to Stokes current + !! (with separate mixing parameter for Eulerian + !! mixing contribution). + !! See Harcourt 2013, 2015 Second-Moment approach + logical :: CoriolisStokes !< This feature is in development and not ready. + ! True if Coriolis-Stokes acceleration should be applied. + real :: Stokes_min_thick_avg !< A layer thickness below which the cell-center Stokes drift is + !! used instead of the cell average [Z ~> m]. This is only used if + !! WAVE_INTERFACE_ANSWER_DATE < 20230101. + integer :: answer_date !< The vintage of the order of arithmetic and expressions in the + !! surface wave calculations. Values below 20230101 recover the + !! answers from the end of 2022, while higher values use updated + !! and more robust forms of the same expressions. + ! Options if WaveMethod is Surface Stokes Drift Bands (1) integer :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers @@ -137,10 +140,14 @@ module MOM_wave_interface ! Options if using FMS DataOverride Routine character(len=40) :: SurfBandFileName !< Filename if using DataOverride + real :: land_speed !< A large Stokes velocity that can be used to indicate land values in + !! a data override file [L T-1 ~> m s-1]. Stokes drift components larger + !! than this are set to zero in data override calls for the Stokes drift. logical :: DataOver_initialized !< Flag for DataOverride Initialization ! Options for computing Langmuir number - real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number + real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number [nondim] + real :: LA_HBL_min !< Minimum boundary layer depth for averaging Langmuir number [Z ~> m] logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number integer :: NumBands = 0 !< Number of wavenumber/frequency partitions to receive @@ -149,6 +156,8 @@ module MOM_wave_interface real :: g_Earth !< The gravitational acceleration, equivalent to GV%g_Earth but with !! different dimensional rescaling appropriate for deep-water gravity !! waves [Z T-2 ~> m s-2] + real :: I_g_Earth !< The inverse of the gravitational acceleration, with dimensional rescaling + !! appropriate for deep-water gravity waves [T2 Z-1 ~> s2 m-1] ! Surface Wave Dependent 1d/2d/3d vars real, allocatable, dimension(:) :: & WaveNum_Cen !< Wavenumber bands for read/coupled [Z-1 ~> m-1] @@ -159,8 +168,6 @@ module MOM_wave_interface real, allocatable, dimension(:) :: & PrescribedSurfStkY !< Surface Stokes drift if prescribed [L T-1 ~> m s-1] real, allocatable, dimension(:,:) :: & - La_SL, & !< SL Langmuir number (directionality factored later) - !! Horizontal -> H points La_Turb !< Aligned Turbulent Langmuir number [nondim] !! Horizontal -> H points real, allocatable, dimension(:,:) :: & @@ -178,12 +185,30 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber - !> An arbitrary lower-bound on the Langmuir number. Run-time parameter. - !! Langmuir number is sqrt(u_star/u_stokes). When both are small - !! but u_star is orders of magnitude smaller the Langmuir number could - !! have unintended consequences. Since both are small it can be safely capped - !! to avoid such consequences. - real :: La_min = 0.05 + real :: La_min !< An arbitrary lower-bound on the Langmuir number [nondim]. + !! Langmuir number is sqrt(u_star/u_stokes). When both are small + !! but u_star is orders of magnitude smaller, the Langmuir number could + !! have unintended consequences. Since both are small it can be safely + !! capped to avoid such consequences. + real :: La_Stk_backgnd !< A small background Stokes velocity used in the denominator of + !! some expressions for the Langmuir number [L T-1 ~> m s-1] + + ! Parameters used in estimating the wind speed or wave properties from the friction velocity + real :: VonKar = -1.0 !< The von Karman coefficient as used in the MOM_wave_interface module [nondim] + real :: rho_air !< A typical density of air at sea level, as used in wave calculations [R ~> kg m-3] + real :: nu_air !< The viscosity of air, as used in wave calculations [Z2 T-1 ~> m2 s-1] + real :: SWH_from_u10sq !< A factor for converting the square of the 10 m wind speed to the + !! significant wave height [Z T2 L-2 ~> s2 m-1] + real :: Charnock_min !< The minimum value of the Charnock coefficient, which relates the square of + !! the air friction velocity divided by the gravitational acceleration to the + !! wave roughness length [nondim] + real :: Charnock_slope_U10 !< The partial derivative of the Charnock coefficient with the 10 m wind + !! speed [T L-1 ~> s m-1]. Note that in eq. 13 of the Edson et al. 2013 describing + !! the COARE 3.5 bulk flux algorithm, this slope is given as 0.017. However, 0.0017 + !! reproduces the curve in their figure 6, so that is the default value used in MOM6. + real :: Charnock_intercept !< The intercept of the fit for the Charnock coefficient in the limit of + !! no wind [nondim]. Note that this can be negative because CHARNOCK_MIN will keep + !! the final value for the Charnock coefficient from being from being negative. ! Options used with the test profile real :: TP_STKX0 !< Test profile x-stokes drift amplitude [L T-1 ~> m s-1] @@ -196,6 +221,8 @@ module MOM_wave_interface logical :: DHH85_is_set !< The if the wave properties have been set when WaveMethod = DHH85. real :: WaveAge !< The fixed wave age used with the DHH85 spectrum [nondim] real :: WaveWind !< Wind speed for the DHH85 spectrum [L T-1 ~> m s-1] + real :: omega_min !< Minimum wave frequency with the DHH85 spectrum [T-1 ~> s-1] + real :: omega_max !< Maximum wave frequency with the DHH85 spectrum [T-1 ~> s-1] type(time_type), pointer :: Time !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the @@ -250,6 +277,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar character*(12), parameter :: DATAOVR_STRING = "DATAOVERRIDE" character*(7), parameter :: COUPLER_STRING = "COUPLER" character*(5), parameter :: INPUT_STRING = "INPUT" + integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags logical :: use_waves logical :: StatisticalWaves @@ -263,7 +291,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "If true, enables surface wave modules.", default=.false.) ! Check if using LA_LI2016 - call get_param(param_file,mdl,"USE_LA_LI2016",StatisticalWaves, & + call get_param(param_file, mdl, "USE_LA_LI2016", StatisticalWaves, & do_not_log=.true.,default=.false.) if (.not.(use_waves .or. StatisticalWaves)) return @@ -273,20 +301,39 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%Time => Time CS%g_Earth = US%L_to_Z**2*GV%g_Earth + CS%I_g_Earth = 1.0 / CS%g_Earth ! Add any initializations needed here CS%DataOver_initialized = .false. call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231) + + call get_param(param_file, mdl, "WAVE_INTERFACE_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic and expressions in the surface wave "//& + "calculations. Values below 20230101 recover the answers from the end of 2022, "//& + "while higher values use updated and more robust forms of the same expressions:\n"//& + "\t < 20230101 - Original answers for wave interface routines\n"//& + "\t >= 20230101 - More robust expressions for Update_Stokes_Drift\n"//& + "\t >= 20230102 - More robust expressions for get_StokesSL_LiFoxKemper\n"//& + "\t >= 20230103 - More robust expressions for ust_2_u10_coare3p5", & + default=20221231) ! In due course change the default to default=default_answer_date) + ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, & - "The depth (normalized by BLD) to average Stokes drift over in "//& - "Langmuir number calculation, where La = sqrt(ust/Stokes).", & - units="nondim", default=0.04) + "The depth (normalized by BLD) to average Stokes drift over in "//& + "Langmuir number calculation, where La = sqrt(ust/Stokes).", & + units="nondim", default=0.04) + call get_param(param_file, mdl, "LA_DEPTH_MIN", CS%LA_HBL_min, & + "The minimum depth over which to average the Stokes drift in the Langmuir "//& + "number calculation.", units="m", default=0.1, scale=US%m_to_Z) if (StatisticalWaves) then CS%WaveMethod = LF17 + call set_LF17_wave_params(param_file, mdl, US, CS) if (.not.use_waves) return else CS%WaveMethod = NULL_WaveMethod @@ -317,22 +364,22 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar endif call get_param(param_file, mdl, "STOKES_VF", CS%Stokes_VF, & - "Flag to use Stokes vortex force", units="", & + "Flag to use Stokes vortex force", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_VF", CS%Passive_Stokes_VF, & - "Flag to make Stokes vortex force diagnostic only.", units="", & + "Flag to make Stokes vortex force diagnostic only.", & Default=.false.) call get_param(param_file, mdl, "STOKES_PGF", CS%Stokes_PGF, & - "Flag to use Stokes-induced pressure gradient anomaly", units="", & + "Flag to use Stokes-induced pressure gradient anomaly", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_PGF", CS%Passive_Stokes_PGF, & - "Flag to make Stokes-induced pressure gradient anomaly diagnostic only.", units="", & + "Flag to make Stokes-induced pressure gradient anomaly diagnostic only.", & Default=.false.) call get_param(param_file, mdl, "STOKES_DDT", CS%Stokes_DDT, & - "Flag to use Stokes d/dt", units="", & + "Flag to use Stokes d/dt", & Default=.false.) call get_param(param_file, mdl, "PASSIVE_STOKES_DDT", CS%Passive_Stokes_DDT, & - "Flag to make Stokes d/dt diagnostic only", units="", & + "Flag to make Stokes d/dt diagnostic only", & Default=.false.) ! Get Wave Method and write to integer WaveMethod @@ -369,6 +416,10 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar units='m', default=50.0, scale=US%m_to_Z) case (SURFBANDS_STRING)! Surface Stokes Drift Bands CS%WaveMethod = SURFBANDS + call get_param(param_file, mdl, "SURFBAND_MIN_THICK_AVG", CS%Stokes_min_thick_avg, & + "A layer thickness below which the cell-center Stokes drift is used instead of "//& + "the cell average. This is only used if WAVE_INTERFACE_ANSWER_DATE < 20230101.", & + units="m", default=0.1, scale=US%m_to_Z, do_not_log=(CS%answer_date>=20230101)) call get_param(param_file, mdl, "SURFBAND_SOURCE", TMPSTRING2, & "Choice of SURFACE_BANDS data mode, valid options include: \n"//& " DATAOVERRIDE - Read from NetCDF using FMS DataOverride. \n"//& @@ -381,7 +432,12 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar case (DATAOVR_STRING)! Using Data Override CS%DataSource = DATAOVR call get_param(param_file, mdl, "SURFBAND_FILENAME", CS%SurfBandFileName, & - "Filename of surface Stokes drift input band data.", default="StkSpec.nc") + "Filename of surface Stokes drift input band data.", default="StkSpec.nc") + call get_param(param_file, mdl, "SURFBAND_OVERRIDE_LAND_SPEED", CS%land_speed, & + "A large Stokes velocity that can be used to indicate land values in "//& + "a data override file. Stokes drift components larger than this are "//& + "set to zero in data override calls for the Stokes drift.", & + units="m s-1", default=10.0, scale=US%m_s_to_L_T) case (COUPLER_STRING)! Reserved for coupling CS%DataSource = COUPLER ! This is just to make something work, but it needs to be read from the wavemodel. @@ -429,15 +485,22 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "Choose true to use waveage in peak frequency.", default=.false.) call get_param(param_file, mdl, "DHH85_AGE", CS%WaveAge, & "Wave Age for DHH85 spectrum.", & - units='', default=1.2) + units='nondim', default=1.2) call get_param(param_file, mdl, "DHH85_WIND", CS%WaveWind, & "Wind speed for DHH85 spectrum.", & units='m s-1', default=10.0, scale=US%m_s_to_L_T) + call get_param(param_file, mdl, "DHH85_MIN_WAVE_FREQ", CS%omega_min, & + "Minimum wave frequency for the DHH85 spectrum.", & + units='s-1', default=0.1, scale=US%T_to_s) + call get_param(param_file, mdl, "DHH85_MAX_WAVE_FREQ", CS%omega_max, & + "Maximum wave frequency for the DHH85 spectrum.", & + units='s-1', default=10.0, scale=US%T_to_s) ! The default is about a 30 cm cutoff wavelength. call get_param(param_file, mdl, "STATIC_DHH85", CS%StaticWaves, & "Flag to disable updating DHH85 Stokes drift.", default=.false.) - case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number + case (LF17_STRING) !Li and Fox-Kemper 17 wind-sea Langmuir number CS%WaveMethod = LF17 - case (EFACTOR_STRING)!Li and Fox-Kemper 16 + call set_LF17_wave_params(param_file, mdl, US, CS) + case (EFACTOR_STRING) !Li and Fox-Kemper 16 CS%WaveMethod = EFACTOR case default call MOM_error(FATAL,'Check WAVE_METHOD.') @@ -445,13 +508,17 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar ! Langmuir number Options (Note that CS%LA_FracHBL is set above.) call get_param(param_file, mdl, "LA_MISALIGNMENT", CS%LA_Misalignment, & - "Flag (logical) if using misalignment bt shear and waves in LA", & + "Flag (logical) if using misalignment between shear and waves in LA", & default=.false.) call get_param(param_file, mdl, "MIN_LANGMUIR", CS%La_min, & "A minimum value for all Langmuir numbers that is not physical, "//& "but is likely only encountered when the wind is very small and "//& - "therefore its effects should be mostly benign.", units="nondim", & - default=0.05) + "therefore its effects should be mostly benign.", & + units="nondim", default=0.05) + call get_param(param_file, mdl, "LANGMUIR_STOKES_BACKGROUND", CS%La_Stk_backgnd, & + "A small background Stokes velocity used in the denominator of some "//& + "expressions for the Langmuir number.", & + units="m s-1", default=1.0e-10, scale=US%m_s_to_L_T, do_not_log=(CS%WaveMethod==LF17)) ! Allocate and initialize ! a. Stokes driftProfiles @@ -469,7 +536,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar 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), 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 @@ -487,9 +553,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s) if (CS%Stokes_DDT) then CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', & - CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2') + CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', & - CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2') + CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_3dstokes_y_from_ddt = register_diag_field('ocean_model','3d_stokes_y_from_ddt', & CS%diag%axesCvL,Time,'3d Stokes drift from ddt (y)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_3dstokes_x_from_ddt = register_diag_field('ocean_model','3d_stokes_x_from_ddt', & @@ -510,6 +576,47 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar end subroutine MOM_wave_interface_init +!> Set the parameters that are used to determine the averaged Stokes drift and Langmuir numbers +subroutine set_LF17_wave_params(param_file, mdl, US, CS) + type(param_file_type), intent(in) :: param_file !< Input parameter structure + character(len=*), intent(in) :: mdl !< A module name to use in the get_param calls + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure + + ! A separate routine is used to set these parameters because there are multiple ways that the + ! underlying parameterizations are enabled. + + call get_param(param_file, mdl, "VISCOSITY_AIR", CS%nu_air, & + "A typical viscosity of air at sea level, as used in wave calculations", & + units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T) + call get_param(param_file, mdl, "VON_KARMAN_WAVES", CS%vonKar, & + "The value the von Karman constant as used for surface wave calculations.", & + units="nondim", default=0.40) ! The default elsewhere in MOM6 is usually 0.41. + call get_param(param_file, mdl, "RHO_AIR", CS%rho_air, & + "A typical density of air at sea level, as used in wave calculations", & + units="kg m-3", default=1.225, scale=US%kg_m3_to_R) + call get_param(param_file, mdl, "WAVE_HEIGHT_SCALE_FACTOR", CS%SWH_from_u10sq, & + "A factor relating the square of the 10 m wind speed to the significant "//& + "wave height, with a default value based on the Pierson-Moskowitz spectrum.", & + units="s2 m-1", default=0.0246, scale=US%m_to_Z*US%L_T_to_m_s**2) + call get_param(param_file, mdl, "CHARNOCK_MIN", CS%Charnock_min, & + "The minimum value of the Charnock coefficient, which relates the square of "//& + "the air friction velocity divided by the gravitational acceleration to the "//& + "wave roughness length.", units="nondim", default=0.028) + call get_param(param_file, mdl, "CHARNOCK_SLOPE_U10", CS%Charnock_slope_U10, & + "The partial derivative of the Charnock coefficient with the 10 m wind speed. "//& + "Note that in eq. 13 of the Edson et al. 2013 describing the COARE 3.5 bulk "//& + "flux algorithm, this slope is given as 0.017. However, 0.0017 reproduces "//& + "the curve in their figure 6, so that is the default value used in MOM6.", & + units="s m-1", default=0.0017, scale=US%L_T_to_m_s) + call get_param(param_file, mdl, "CHARNOCK_0_WIND_INTERCEPT", CS%Charnock_intercept, & + "The intercept of the fit for the Charnock coefficient in the limit of no wind. "//& + "Note that this can be negative because CHARNOCK_MIN will keep the final "//& + "value for the Charnock coefficient from being from being negative.", & + units="nondim", default=-0.005) + +end subroutine set_LF17_wave_params + !> This interface provides the caller with information from the waves control structure. subroutine query_wave_properties(CS, NumBands, WaveNumbers, US) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure @@ -614,29 +721,23 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. - real, intent(in) :: dt !< Time-step for computing Stokes-tendency + real, intent(in) :: dt !< Time-step for computing Stokes-tendency [T ~> s] logical, intent(in) :: dynamics_step !< True if this call is on a dynamics step ! Local Variables real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m] - real :: one_cm ! One centimeter in the units of wavelengths [Z ~> m] real :: level_thick ! The thickness of each layer [Z ~> m] - real :: min_level_thick_avg ! A minimum layer thickness for inclusion in the average [Z ~> m] real :: DecayScale ! A vertical decay scale in the test profile [Z ~> m] real :: CMN_FAC ! A nondimensional factor [nondim] real :: WN ! Model wavenumber [Z-1 ~> m-1] real :: UStokes ! A Stokes drift velocity [L T-1 ~> m s-1] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] real :: La ! The local Langmuir number [nondim] integer :: ii, jj, kk, b, iim1, jjm1 - real :: idt ! 1 divided by the time step + real :: I_dt ! The inverse of the time step [T-1 ~> s-1] if (CS%WaveMethod==EFACTOR) return - one_cm = 0.01*US%m_to_Z - min_level_thick_avg = 1.e-3*US%m_to_Z - idt = 1.0/dt - if (allocated(CS%US_x) .and. allocated(CS%US_y)) then call pass_vector(CS%US_x(:,:,:),CS%US_y(:,:,:), G%Domain) endif @@ -697,35 +798,40 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) level_thick = 0.5*GV%H_to_Z*(h(II,jj,kk)+h(IIm1,jj,kk)) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick - ! -> Stokes drift in thin layers not averaged. - if (level_thick>min_level_thick_avg) then + + if (CS%answer_date >= 20230101) then + ! Use more accurate and numerically stable expressions that work even for vanished layers. do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then + ! Average over a layer using the bin's central wavenumber. + CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) + else + ! Use an analytic expression for the average of an exponential over a layer + WN = CS%Freq_Cen(b)**2 * CS%I_g_Earth + CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) + endif + CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC + enddo + + elseif (level_thick > CS%Stokes_min_thick_avg) then + ! -> Stokes drift in thin layers not averaged. + do b = 1,CS%NumBands + if (CS%PartitionMode == 0) then ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b))) & / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif (CS%PartitionMode==1) then - if (CS%StkLevelMode==0) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif (CS%StkLevelMode==1) then - ! Use a numerical integration and then divide by layer thickness - WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g - CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) - endif + else + ! Use a numerical integration and then divide by layer thickness + WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g + CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC enddo - else - ! Take the value at the midpoint + else ! Take the value at the midpoint do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then CMN_FAC = exp(MidPoint * 2. * CS%WaveNum_Cen(b)) - elseif (CS%PartitionMode==1) then + else CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) endif CS%US_x(II,jj,kk) = CS%US_x(II,jj,kk) + CS%STKx0(II,jj,b)*CMN_FAC @@ -734,6 +840,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) enddo enddo enddo + ! Computing Y direction Stokes drift do JJ = G%jscB,G%jecB do ii = G%isc,G%iec @@ -749,35 +856,39 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) level_thick = 0.5*GV%H_to_Z*(h(ii,JJ,kk)+h(ii,JJm1,kk)) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick - ! -> Stokes drift in thin layers not averaged. - if (level_thick>min_level_thick_avg) then + + if (CS%answer_date >= 20230101) then + ! Use more accurate and numerically stable expressions that work even for vanished layers. + do b = 1,CS%NumBands + if (CS%PartitionMode == 0) then + ! Average over a layer using the bin's central wavenumber. + CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) + else + ! Use an analytic expression for the average of an exponential over a layer + WN = CS%Freq_Cen(b)**2 * CS%I_g_Earth + CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) + endif + CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC + enddo + elseif (level_thick > CS%Stokes_min_thick_avg) then + ! -> Stokes drift in thin layers not averaged. do b = 1,CS%NumBands - if (CS%PartitionMode==0) then - ! In wavenumber we are averaging over level - CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b)))& + if (CS%PartitionMode == 0) then + ! In wavenumber we are averaging over level + CMN_FAC = (exp(Top*2.*CS%WaveNum_Cen(b))-exp(Bottom*2.*CS%WaveNum_Cen(b))) & / ((Top-Bottom)*(2.*CS%WaveNum_Cen(b))) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*CS%WaveNum_Cen(b)*Top) * one_minus_exp_x(2.*CS%WaveNum_Cen(b)*level_thick) - elseif (CS%PartitionMode==1) then - if (CS%StkLevelMode==0) then - ! Take the value at the midpoint - CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) - elseif (CS%StkLevelMode==1) then - ! Use a numerical integration and then divide by layer thickness - WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g - CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) - !### For accuracy and numerical stability rewrite this as: - ! CMN_FAC = exp(2.*WN*Top) * one_minus_exp_x(2.*WN*level_thick) - endif + else + ! Use a numerical integration and then divide by layer thickness + WN = CS%Freq_Cen(b)**2 / CS%g_Earth !bgr bug-fix missing g + CMN_FAC = (exp(2.*WN*Top)-exp(2.*WN*Bottom)) / (2.*WN*(Top-Bottom)) endif CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC enddo - else - ! Take the value at the midpoint + else ! Take the value at the midpoint do b = 1,CS%NumBands - if (CS%PartitionMode==0) then + if (CS%PartitionMode == 0) then CMN_FAC = exp(MidPoint*2.*CS%WaveNum_Cen(b)) - elseif (CS%PartitionMode==1) then + else CMN_FAC = exp(MidPoint * 2. * CS%Freq_Cen(b)**2 / CS%g_Earth) endif CS%US_y(ii,JJ,kk) = CS%US_y(ii,JJ,kk) + CS%STKy0(ii,JJ,b)*CMN_FAC @@ -863,8 +974,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! Finding tendency of Stokes drift over the time step to apply ! as an acceleration to the models current. if ( dynamics_step .and. CS%Stokes_DDT ) then - CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%US_x_prev(:,:,:)) * idt - CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%US_y_prev(:,:,:)) * idt + I_dt = 1.0 / dt + CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%US_x_prev(:,:,:)) * I_dt + CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%US_y_prev(:,:,:)) * I_dt CS%US_x_prev(:,:,:) = CS%US_x(:,:,:) CS%US_y_prev(:,:,:) = CS%US_y(:,:,:) endif @@ -896,7 +1008,7 @@ end subroutine Update_Stokes_Drift !> Return the value of (1 - exp(-x))/x, using an accurate expression for small values of x. real function one_minus_exp_x(x) real, intent(in) :: x !< The argument of the function ((1 - exp(-x))/x) [nondim] - real, parameter :: C1_6 = 1.0/6.0 + real, parameter :: C1_6 = 1.0/6.0 ! A rational fraction [nondim] if (abs(x) <= 2.0e-5) then ! The Taylor series expression for exp(-x) gives a more accurate expression for 64-bit reals. one_minus_exp_x = 1.0 - x * (0.5 - C1_6*x) @@ -916,11 +1028,11 @@ subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS) ! Local variables real :: temp_x(SZI_(G),SZJ_(G)) ! Pseudo-zonal Stokes drift of band at h-points [L T-1 ~> m s-1] - real :: temp_y(SZI_(G),SZJ_(G)) ! Psuedo-meridional Stokes drift of band at h-points [L T-1 ~> m s-1] + real :: temp_y(SZI_(G),SZJ_(G)) ! Pseudo-meridional Stokes drift of band at h-points [L T-1 ~> m s-1] integer, dimension(4) :: sizes ! The sizes of the various dimensions of the variable. character(len=48) :: dim_name(4) ! The names of the dimensions of the variable. character(len=20) :: varname ! The name of an input variable for data override. - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] logical :: wavenumber_exists integer :: ndims, b, i, j @@ -994,7 +1106,7 @@ subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS) ! Filter land values do j = G%jsd,G%jed do i = G%Isd,G%Ied - if ((abs(temp_x(i,j)) > 10.0*US%m_s_to_L_T) .or. (abs(temp_y(i,j)) > 10.0*US%m_s_to_L_T)) then + if ((abs(temp_x(i,j)) > CS%land_speed) .or. (abs(temp_y(i,j)) > CS%land_speed)) then ! Assume land-mask and zero out temp_x(i,j) = 0.0 temp_y(i,j) = 0.0 @@ -1058,9 +1170,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & real, allocatable :: StkBand_X(:), StkBand_Y(:) ! Stokes drifts by band [L T-1 ~> m s-1] integer :: KK, BB - - ! Compute averaging depth for Stokes drift (negative) - Dpt_LASL = min(-0.1*US%m_to_Z, -Waves%LA_FracHBL*HBL) + ! Compute averaging depth for Stokes drift (negative) + Dpt_LASL = -1.0*max(Waves%LA_FracHBL*HBL, Waves%LA_HBL_min) USE_MA = Waves%LA_Misalignment if (present(Override_MA)) USE_MA = Override_MA @@ -1113,19 +1224,15 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & call get_StokesSL_LiFoxKemper(ustar, hbl*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA) elseif (Waves%WaveMethod==Null_WaveMethod) then call MOM_error(FATAL, "Get_Langmuir_number called without defining a WaveMethod. "//& - "Suggest to make sure USE_LT is set/overridden to False or "//& - "choose a wave method (or set USE_LA_LI2016 to use statistical "//& - "waves.") + "Suggest to make sure USE_LT is set/overridden to False or choose "//& + "a wave method (or set USE_LA_LI2016 to use statistical waves).") endif if (.not.(Waves%WaveMethod==LF17)) then - ! This is an arbitrary lower bound on Langmuir number. - ! We shouldn't expect values lower than this, but - ! there is also no good reason to cap it here other then - ! to prevent large enhancements in unconstrained parts of - ! the curve fit parameterizations. - ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. - LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + 1.e-10*US%m_s_to_L_T))) + ! This expression uses an arbitrary lower bound on Langmuir number. + ! We shouldn't expect values lower than this, but there is also no good reason to cap it here + ! other than to prevent large enhancements in unconstrained parts of the curve fit parameterizations. + LA = max(Waves%La_min, sqrt(US%Z_to_L*ustar / (LA_STK + Waves%La_Stk_backgnd))) endif if (Use_MA) then @@ -1168,7 +1275,7 @@ end function get_wave_method !! !! Update (Jan/25): !! - Converted from function to subroutine, now returns Langmuir number. -!! - Computs 10m wind internally, so only ustar and hbl need passed to +!! - Compute 10m wind internally, so only ustar and hbl need passed to !! subroutine. !! !! Qing Li, 160606 @@ -1183,19 +1290,14 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure real, intent(out) :: UStokes_SL !< Surface layer averaged Stokes drift [L T-1 ~> m s-1] - real, intent(out) :: LA !< Langmuir number + real, intent(out) :: LA !< Langmuir number [nondim] ! Local variables ! parameters - real, parameter :: & - ! ratio of U19.5 to U10 (Holthuijsen, 2007) [nondim] - u19p5_to_u10 = 1.075, & - ! ratio of mean frequency to peak frequency for - ! Pierson-Moskowitz spectrum (Webb, 2011) [nondim] - fm_into_fp = 1.296, & - ! ratio of surface Stokes drift to U10 [nondim] - us_to_u10 = 0.0162, & - ! loss ratio of Stokes transport [nondim] - r_loss = 0.667 + real, parameter :: u19p5_to_u10 = 1.075 ! ratio of U19.5 to U10 (Holthuijsen, 2007) [nondim] + real, parameter :: fm_into_fp = 1.296 ! ratio of mean frequency to peak frequency for + ! Pierson-Moskowitz spectrum (Webb, 2011) [nondim] + real, parameter :: us_to_u10 = 0.0162 ! ratio of surface Stokes drift to U10 [nondim] + real, parameter :: r_loss = 0.667 ! loss ratio of Stokes transport [nondim] real :: UStokes ! The surface Stokes drift [L T-1 ~> m s-1] real :: hm0 ! The significant wave height [Z ~> m] real :: fm ! The mean wave frequency [T-1 ~> s-1] @@ -1204,13 +1306,13 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) real :: kstar ! A rescaled wavenumber? [Z-1 ~> m-1] real :: vstokes ! The total Stokes transport [Z L T-1 ~> m2 s-1] real :: z0 ! The boundary layer depth [Z ~> m] - real :: z0i ! The inverse of theboundary layer depth [Z-1 ~> m-1] + real :: z0i ! The inverse of the boundary layer depth [Z-1 ~> m-1] real :: r1, r2, r3, r4 ! Nondimensional ratios [nondim] - ! real :: r5 ! A single expression that combines r3 and r4 [nondim] - ! real :: root_2kz ! The square root of twice the peak wavenumber times the - ! ! boundary layer depth [nondim] + real :: r5 ! A single expression that combines r2 and r4 [nondim] + real :: root_2kz ! The square root of twice the peak wavenumber times the + ! boundary layer depth [nondim] real :: u10 ! The 10 m wind speed [L T-1 ~> m s-1] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] PI = 4.0*atan(1.0) UStokes_sl = 0.0 @@ -1219,12 +1321,12 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! This code should be revised to minimize the number of divisions and cancel out common factors. ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/(1.225*US%kg_m3_to_R)), u10, GV, US, CS) + call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/CS%rho_air), u10, GV, US, CS) ! surface Stokes drift UStokes = us_to_u10*u10 ! ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) - hm0 = 0.0246*US%m_to_Z*US%L_T_to_m_s**2 * u10**2 + hm0 = CS%SWH_from_u10sq * u10**2 ! ! peak frequency (PM, Bouws, 1998) fp = 0.877 * (US%L_to_Z*GV%g_Earth) / (2.0 * PI * u19p5_to_u10 * u10) @@ -1241,57 +1343,61 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! the general peak wavenumber for Phillips' spectrum ! (Breivik et al., 2016) with correction of directional spreading kphil = 0.176 * UStokes / vstokes - ! - ! surface layer averaged Stokes drift with Stokes drift profile - ! estimated from Phillips' spectrum (Breivik et al., 2016) - ! the directional spreading effect from Webb and Fox-Kemper, 2015 - ! is also included - kstar = kphil * 2.56 - ! surface layer - z0 = abs(hbl) - z0i = 1.0 / z0 ! Combining all of the expressions above gives kPhil as the following ! where the first two lines are just a constant: - ! kPhil = ((0.176 * us_to_u10 * u19p5_to_u10) / & - ! (0.5*0.125 * r_loss * fm_into_fp * 0.877 * 0.0246**2)) * & - ! (US%T_to_s*US%m_s_to_L_T)**2 / (CS%g_Earth * u10**2) - - ! Terms 1 to 4, as written in the appendix of Li et al. (2017) - r1 = ( 0.151 / kphil * z0i - 0.84 ) * & - ( 1.0 - exp(-2.0 * kphil * z0) ) - r2 = -( 0.84 + 0.0591 / kphil * z0i ) * & - sqrt( 2.0 * PI * kphil * z0 ) * & - erfc( sqrt( 2.0 * kphil * z0 ) ) - r3 = ( 0.0632 / kstar * z0i + 0.125 ) * & - (1.0 - exp(-2.0 * kstar * z0) ) - r4 = ( 0.125 + 0.0946 / kstar * z0i ) * & - sqrt( 2.0 * PI * kstar * z0) * & - erfc( sqrt( 2.0 * kstar * z0 ) ) - UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - - ! The following is equivalent to the code above, but avoids singularities -! r1 = ( 0.302 - 1.68*kphil*z0 ) * one_minus_exp_x(2.0*kphil * z0) -! r3 = ( 0.1264 + 0.64*kphil*z0 ) * one_minus_exp_x(5.12*kphil * z0) -! root_2kz = sqrt(2.0 * kphil * z0) -! ! r2 = -( 0.84 + 0.0591*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) -! ! r4 = ( 0.2 + 0.059125*2.0 / (root_2kz**2) ) * sqrt(PI)* root_2kz * erfc( 1.6 * root_2kz ) -! -! ! r5 = r2 + r4 (with a small correction to one coefficient to avoid a singularity when z0 = 0): -! ! The correction leads to <1% relative differences in (r2+r4) for root_2kz > 0.05, but without -! ! it the values of r2 + r4 are qualitatively wrong (>50% errors) for root_2kz < 0.0015 . -! ! It has been verified that these two expressions for r5 are the same to 6 decimal places for -! ! root_2kz between 1e-10 and 1e-3, but that the first one degrades for smaller values. -! if (root_2kz > 1e-3) then -! r5 = sqrt(PI) * (root_2kz * (-0.84 * erfc(root_2kz) + 0.2 * erfc(1.6*root_2kz)) + & -! 0.1182 * (erfc(1.6*root_2kz) - erfc(root_2kz)) / root_2kz) -! else -! ! It is more accurate to replace erf with the first two terms of its Taylor series -! ! erf(z) = (2/sqrt(pi)) * z * (1. - (1/3)*z**2 + (1/10)*z**4 - (1/42)*z**6 + ...) -! ! and then cancel or combine common terms and drop negligibly small terms. -! r5 = -0.64*sqrt(PI)*root_2kz + (-0.14184 + 1.0839648 * root_2kz**2) -! endif -! UStokes_sl = UStokes * (0.715 + ((r1 + r2) + r5)) + ! kphil = ((0.176 * us_to_u10 * u19p5_to_u10) / & + ! (0.5*0.125 * r_loss * fm_into_fp * 0.877 * CS%SWH_from_u10sq**2)) / & + ! (GV%g_Earth * u10**2) + + ! surface layer + z0 = abs(hbl) + + if (CS%answer_date < 20230102) then + z0i = 1.0 / z0 + + ! Surface layer averaged Stokes drift with Stokes drift profile + ! estimated from Phillips' spectrum (Breivik et al., 2016) + ! The directional spreading effect from Webb and Fox-Kemper, 2015 is also included. + kstar = kphil * 2.56 + + ! Terms 1 to 4, as written in the appendix of Li et al. (2017) + r1 = ( 0.151 / kphil * z0i - 0.84 ) * & + ( 1.0 - exp(-2.0 * kphil * z0) ) + r2 = -( 0.84 + 0.0591 / kphil * z0i ) * & + sqrt( 2.0 * PI * kphil * z0 ) * & + erfc( sqrt( 2.0 * kphil * z0 ) ) + r3 = ( 0.0632 / kstar * z0i + 0.125 ) * & + (1.0 - exp(-2.0 * kstar * z0) ) + r4 = ( 0.125 + 0.0946 / kstar * z0i ) * & + sqrt( 2.0 * PI * kstar * z0) * & + erfc( sqrt( 2.0 * kstar * z0 ) ) + UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) + else + ! The following is equivalent to the code above, but avoids singularities + r1 = ( 0.302 - 1.68*(kphil*z0) ) * one_minus_exp_x(2.0 * (kphil * z0)) + r3 = ( 0.1264 + 0.64*(kphil*z0) ) * one_minus_exp_x(5.12 * (kphil * z0)) + + root_2kz = sqrt(2.0 * kphil * z0) + ! r2 = -( 0.84 + 0.0591*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( root_2kz ) + ! r4 = ( 0.2 + 0.059125*2.0 / (root_2kz**2) ) * sqrt(PI) * root_2kz * erfc( 1.6 * root_2kz ) + + ! r5 = r2 + r4 (with a small correction to one coefficient to avoid a singularity when z0 = 0): + ! The correction leads to <1% relative differences in (r2+r4) for root_2kz > 0.05, but without + ! it the values of r2 + r4 are qualitatively wrong (>50% errors) for root_2kz < 0.0015 . + ! It has been verified that these two expressions for r5 are the same to 6 decimal places for + ! root_2kz between 1e-10 and 1e-3, but that the first one degrades for smaller values. + if (root_2kz > 1e-3) then + r5 = sqrt(PI) * (root_2kz * (-0.84 * erfc(root_2kz) + 0.2 * erfc(1.6*root_2kz)) + & + 0.1182 * (erfc(1.6*root_2kz) - erfc(root_2kz)) / root_2kz) + else + ! It is more accurate to replace erf with the first two terms of its Taylor series + ! erf(z) = (2/sqrt(pi)) * z * (1. - (1/3)*z**2 + (1/10)*z**4 - (1/42)*z**6 + ...) + ! and then cancel or combine common terms and drop negligibly small terms. + r5 = -0.64*sqrt(PI)*root_2kz + (-0.14184 + 1.0839648 * root_2kz**2) + endif + UStokes_sl = UStokes * (0.715 + ((r1 + r3) + r5)) + endif if (UStokes_sl /= 0.0) LA = sqrt(US%Z_to_L*ustar / UStokes_sl) endif @@ -1306,13 +1412,13 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) real, dimension(SZK_(GV)), & intent(in) :: H !< Grid thickness [H ~> m or kg m-2] real, dimension(SZK_(GV)), & - intent(in) :: Profile !< Profile of quantity to be averaged [arbitrary] + intent(in) :: Profile !< Profile of quantity to be averaged in arbitrary units [A] !! (used here for Stokes drift) - real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [arbitrary] + real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [A] !! (used here for Stokes drift) !Local variables real :: top, midpoint, bottom ! Depths, negative downward [Z ~> m]. - real :: Sum + real :: Sum ! The depth weighted vertical sum of a quantity [A Z ~> A m] integer :: kk ! Initializing sum @@ -1392,23 +1498,18 @@ subroutine DHH85_mid(GV, US, CS, zpt, UStokes) real :: omega_peak ! The peak wave frequency [T-1 ~> s-1] real :: omega ! The average frequency in the band [T-1 ~> s-1] real :: domega ! The width in frequency of the band [T-1 ~> s-1] - real :: omega_min ! The minimum wave frequency [T-1 ~> s-1] - real :: omega_max ! The maximum wave frequency [T-1 ~> s-1] real :: u10 ! The wind speed for this spectrum [Z T-1 ~> m s-1] real :: wavespec ! The wave spectrum [L Z T ~> m2 s] real :: Stokes ! The Stokes displacement per cycle [L ~> m] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] integer :: Nomega ! The number of wavenumber bands integer :: OI u10 = CS%WaveWind*US%L_to_Z !/ - omega_min = 0.1*US%T_to_s ! Hz - ! Cut off at 30cm for now... - omega_max = 10.*US%T_to_s ! ~sqrt(0.2*g_Earth*2*pi/0.3) NOmega = 1000 - domega = (omega_max-omega_min)/real(NOmega) + domega = (CS%omega_max - CS%omega_min) / real(NOmega) ! if (CS%WaveAgePeakFreq) then @@ -1427,13 +1528,13 @@ subroutine DHH85_mid(GV, US, CS, zpt, UStokes) endif !/ UStokes = 0.0 - omega = omega_min + 0.5*domega + omega = CS%omega_min + 0.5*domega do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) - ! wavespec units = m2s + ! wavespec units [L Z T ~> m2 s] wavespec = US%Z_to_L * (Ann * CS%g_Earth**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn - ! Stokes units m (multiply by frequency range for units of m/s) + ! Stokes units [L ~> m] (multiply by frequency range for units of [L T-1 ~> m s-1]) Stokes = 2.0 * wavespec * omega**3 * & exp( 2.0 * omega**2 * zpt / CS%g_Earth) / CS%g_Earth UStokes = UStokes + Stokes*domega @@ -1461,7 +1562,7 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) ! Local variables real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z L T-2 ~> m2 s-2] real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. - integer :: i,j,k + integer :: i, j, k ! This is a template to think about down-Stokes mixing. ! This is not ready for use... @@ -1564,19 +1665,21 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< Lagrangian Velocity i-component [m s-1] + intent(in) :: u !< Lagrangian Velocity i-component [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< Lagrangian Velocity j-component [m s-1] + intent(in) :: v !< Lagrangian Velocity j-component [L T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2] + intent(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2 ~> m s-2] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(out) :: PFv_Stokes !< PGF Stokes-shear j-component [m s-1] + intent(out) :: PFv_Stokes !< PGF Stokes-shear j-component [L T-2 ~> m s-2] type(Wave_parameters_CS), & pointer :: CS !< Surface wave related control structure. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The stokes induced Pressure anomaly, layer averaged - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The stokes induced Pressure anomaly at interfaces + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The Stokes induced pressure anomaly, + ! layer averaged [L2 T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The Stokes induced pressure anomaly + ! at interfaces [L2 T-2 ~> m2 s-2] real :: P_Stokes_l, P_Stokes_r ! Stokes-induced pressure anomaly over layer (left/right of point) [L2 T-2 ~> m2 s-2] real :: P_Stokes_l0, P_Stokes_r0 ! Stokes-induced pressure anomaly at interface ! (left/right of point) [L2 T-2 ~> m2 s-2] @@ -1589,11 +1692,12 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) real :: zi_l(SZK_(G)+1), zi_r(SZK_(G)+1) ! The height of the edges of the cells (left/right of point) [Z ~> m]. real :: idz_l(SZK_(G)), idz_r(SZK_(G)) ! The inverse thickness of the cells (left/right of point) [Z-1 ~> m-1] real :: h_l, h_r ! The thickness of the cell (left/right of point) [Z ~> m]. - real :: dexp2kzL,dexp4kzL,dexp2kzR,dexp4kzR ! Analytical evaluation of multi-exponential decay contribution - ! to Stokes pressure anomalies. - real :: TwoK, FourK, iTwoK, iFourK ! Wavenumber multipliers/inverses + real :: dexp2kzL, dexp4kzL, dexp2kzR, dexp4kzR ! Analytical evaluation of multi-exponential decay + ! contribution to Stokes pressure anomalies [nondim]. + real :: TwoK, FourK ! Wavenumbers multiplied by a factor [Z-1 ~> m-1] + real :: iTwoK, iFourK ! Inverses of wavenumbers [Z ~> m] - integer :: i,j,k,l + integer :: i, j, k, l !--------------------------------------------------------------- ! Compute the Stokes contribution to the pressure gradient force @@ -1616,7 +1720,7 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) if (CS%id_P_deltaStokes_L > 0) P_deltaStokes_L(:,:,:) = 0.0 ! First compute PGFu. The Stokes-induced pressure anomaly diagnostic is stored from this calculation. - ! > Seeking PGFx at (I,j), meanining we need to compute pressure at h-points (i,j) and (i+1,j). + ! > Seeking PGFx at (I,j), meaning we need to compute pressure at h-points (i,j) and (i+1,j). ! UL(i,j) -> found as average of I-1 & I on j ! UR(i+1,j) -> found as average of I & I+1 on j ! VL(i,j) -> found on i as average of J-1 & J @@ -1712,7 +1816,7 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) enddo ; enddo ! Next compute PGFv. The Stokes-induced pressure anomaly diagnostic is stored from this calculation. - ! > Seeking PGFy at (i,J), meanining we need to compute pressure at h-points (i,j) and (i,j+1). + ! > Seeking PGFy at (i,J), meaning we need to compute pressure at h-points (i,j) and (i,j+1). ! UL(i,j) -> found as average of I-1 & I on j ! UR(i,j+1) -> found as average of I-1 & I on j+1 ! VL(i,j) -> found on i as average of J-1 & J @@ -1824,12 +1928,15 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure ! Local variables - real, parameter :: vonkar = 0.4 ! Should access a get_param von karman - real :: nu ! The viscosity of air [Z2 T-1 ~> m2 s-1] real :: z0sm, z0, z0rough ! Roughness lengths [Z ~> m] + real :: ten_m_scale ! The 10 m reference height, in rescaled units [Z ~> m] + real :: I_ten_m_scale ! The inverse of the 10 m reference height, in rescaled units [Z-1 ~> m-1] real :: u10a ! The previous guess for u10 [L T-1 ~> m s-1] - real :: alpha ! A nondimensional factor in a parameterization [nondim] - real :: CD ! The drag coefficient [nondim] + real :: alpha ! The Charnock coeffient relating the wind friction velocity squared to the + ! roughness length [nondim] + real :: Cd ! The drag coefficient [nondim] + real :: I_sqrtCd ! The inverse of the square root of the drag coefficient [nondim] + real :: I_vonKar ! The inverse of the von Karman coefficient [nondim] integer :: CT ! Uses empirical formula for z0 to convert ustar_air to u10 based on the @@ -1838,33 +1945,56 @@ subroutine ust_2_u10_coare3p5(USTair, U10, GV, US, CS) ! Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, ! m=0.0017 reproduces the curve in their figure 6. - nu = 1.0e-6*US%m2_s_to_Z2_T ! Should access a get_param for air-viscosity + if (CS%vonKar < 0.0) call MOM_error(FATAL, & + "ust_2_u10_coare3p5 called with a negative value of Waves%vonKar") - z0sm = 0.11 * nu / USTair ! Compute z0smooth from ustar guess - u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 - ! For efficiency change the line above to USTair * sqrt(1000.0) or USTair * 31.6227766 . + z0sm = 0.11 * CS%nu_air / USTair ! Compute z0smooth from ustar guess u10a = 1000.0*US%m_s_to_L_T ! An insanely large upper bound for u10. - CT=0 - do while (abs(u10a/u10 - 1.) > 0.001) ! Change this to (abs(u10a - u10) > 0.001*u10) for efficiency. - CT=CT+1 - u10a = u10 - alpha = min(0.028, 0.0017*US%L_T_to_m_s * u10 - 0.005) - z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess - z0 = z0sm + z0rough - CD = ( vonkar / log(10.*US%m_to_Z / z0) )**2 ! Compute CD from derived roughness - u10 = US%Z_to_L*USTair/sqrt(CD) ! Compute new u10 from derived CD, while loop - ! ends and checks for convergence...CT counter - ! makes sure loop doesn't run away if function - ! doesn't converge. This code was produced offline - ! and converged rapidly (e.g. 2 cycles) - ! for ustar=0.0001:0.0001:10. - if (CT>20) then - u10 = US%Z_to_L*USTair/sqrt(0.0015) ! I don't expect to get here, but just - ! in case it will output a reasonable value. - exit - endif - enddo + if (CS%answer_date < 20230103) then + u10 = US%Z_to_L*USTair / sqrt(0.001) ! Guess for u10 + ten_m_scale = 10.0*US%m_to_Z + CT=0 + do while (abs(u10a/u10 - 1.) > 0.001) + CT=CT+1 + u10a = u10 + alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) + z0rough = alpha * (US%Z_to_L*USTair)**2 / GV%g_Earth ! Compute z0rough from ustar guess + z0 = z0sm + z0rough + Cd = ( CS%vonKar / log(ten_m_scale / z0) )**2 ! Compute Cd from derived roughness + u10 = US%Z_to_L*USTair/sqrt(Cd) ! Compute new u10 from derived Cd, while loop + ! ends and checks for convergence...CT counter + ! makes sure loop doesn't run away if function + ! doesn't converge. This code was produced offline + ! and converged rapidly (e.g. 2 cycles) + ! for ustar=0.0001:0.0001:10. + if (CT>20) then + u10 = US%Z_to_L*USTair/sqrt(0.0015) ! I don't expect to get here, but just + ! in case it will output a reasonable value. + exit + endif + enddo + + else ! Use more efficient expressions that are mathematically equivalent to those above. + u10 = US%Z_to_L*USTair * sqrt(1000.0) ! First guess for u10. + ! In the line above 1000 is the inverse of a plausible first guess of the drag coefficient. + I_vonKar = 1.0 / CS%vonKar + I_ten_m_scale = 0.1*US%Z_to_m + + do CT=1,20 + if (abs(u10a - u10) <= 0.001*u10) exit ! Check for convergence. + u10a = u10 + alpha = min(CS%Charnock_min, CS%Charnock_slope_U10 * u10 + CS%Charnock_intercept) + z0rough = alpha * (CS%I_g_Earth * USTair**2) ! Compute z0rough from ustar guess + z0 = z0sm + z0rough + I_sqrtCd = abs(log(z0 * I_ten_m_scale)) * I_vonKar ! Compute Cd from derived roughness + u10 = US%Z_to_L*USTair * I_sqrtCd ! Compute new u10 from the derived Cd. + enddo + + ! Output a reasonable estimate of u10 if the iteration has not converged. The hard-coded + ! number 25.82 is 1/sqrt(0.0015) to 4 decimal places, but the exact value should not matter. + if (abs(u10a - u10) > 0.001*u10) u10 = US%Z_to_L*USTair * 25.82 + endif end subroutine ust_2_u10_coare3p5 @@ -1876,7 +2006,6 @@ subroutine Waves_end(CS) if (allocated(CS%Freq_Cen)) deallocate( CS%Freq_Cen ) if (allocated(CS%Us_x)) deallocate( CS%Us_x ) if (allocated(CS%Us_y)) deallocate( CS%Us_y ) - if (allocated(CS%La_SL)) deallocate( CS%La_SL ) if (allocated(CS%La_turb)) deallocate( CS%La_turb ) if (allocated(CS%STKx0)) deallocate( CS%STKx0 ) if (allocated(CS%STKy0)) deallocate( CS%STKy0 ) @@ -1889,10 +2018,11 @@ subroutine Waves_end(CS) end subroutine Waves_end !> Register wave restart fields. To be called before MOM_wave_interface_init -subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) +subroutine waves_register_restarts(CS, HI, GV, US, param_file, restart_CSp) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(hor_index_type), intent(inout) :: HI !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout) ! Local variables @@ -1916,21 +2046,20 @@ subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp) if (.not.(use_waves .or. StatisticalWaves)) return - call get_param(param_file,mdl,"STOKES_DDT",time_tendency_term, do_not_log=.true., default=.false.) + call get_param(param_file, mdl, "STOKES_DDT", time_tendency_term, do_not_log=.true., default=.false.) if (time_tendency_term) then ! Allocate wave fields needed for restart file - allocate(CS%Us_x_prev(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke)) - CS%Us_x_prev(:,:,:) = 0.0 - allocate(CS%Us_y_prev(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke)) - CS%Us_y_prev(:,:,:) = 0.0 - ! Register to restart + allocate(CS%Us_x_prev(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(CS%Us_y_prev(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) + + ! Register to restart files. If these are not found in a restart file, they stay 0. vd(1) = var_desc("Us_x_prev", "m s-1", "3d zonal Stokes drift profile",& - hor_grid='u',z_grid='L') + hor_grid='u', z_grid='L') vd(2) = var_desc("Us_y_prev", "m s-1", "3d meridional Stokes drift profile",& - hor_grid='v',z_grid='L') - call register_restart_field(CS%US_x_prev(:,:,:), vd(1), .false., restart_CSp) - call register_restart_field(CS%US_y_prev(:,:,:), vd(2), .false., restart_CSp) + hor_grid='v', z_grid='L') + call register_restart_pair(CS%US_x_prev, CS%US_y_prev, vd(1), vd(2), .false., & + restart_CSp, conversion=US%L_T_to_m_s) endif end subroutine waves_register_restarts @@ -1946,7 +2075,7 @@ end subroutine waves_register_restarts !! interpret surface wave data for MOM6. In its original form, the !! capabilities include setting the Stokes drift in the model (from a !! variety of sources including prescribed, empirical, and input -!! files). In short order, the plan is to also ammend the subroutine +!! files). In short order, the plan is to also amend the subroutine !! to accept Stokes drift information from an external coupler. !! Eventually, it will be necessary to break this file apart so that !! general wave information may be stored in the control structure diff --git a/src/user/Neverworld_initialization.F90 b/src/user/Neverworld_initialization.F90 index 0ba2cbba01..fcd40cf8da 100644 --- a/src/user/Neverworld_initialization.F90 +++ b/src/user/Neverworld_initialization.F90 @@ -40,12 +40,13 @@ subroutine Neverworld_initialize_topography(D, G, param_file, max_depth) ! Local variables real :: PI ! 3.1415926... calculated as 4*atan(1) - real :: x, y + real :: x, y ! Lateral positions normalized by the domain size [nondim] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "Neverworld_initialize_topography" ! This subroutine's name. + real :: nl_top_amp ! Amplitude of large-scale topographic features as a fraction of the maximum depth [nondim] + real :: nl_roughness_amp ! Amplitude of topographic roughness as a fraction of the maximum depth [nondim] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - real :: nl_roughness_amp, nl_top_amp is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -53,16 +54,16 @@ subroutine Neverworld_initialize_topography(D, G, param_file, max_depth) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "NL_ROUGHNESS_AMP", nl_roughness_amp, & - "Amplitude of wavy signal in bathymetry.", default=0.05) + "Amplitude of wavy signal in bathymetry.", units="nondim", default=0.05) call get_param(param_file, mdl, "NL_CONTINENT_AMP", nl_top_amp, & - "Scale factor for topography - 0.0 for no continents.", default=1.0) + "Scale factor for topography - 0.0 for no continents.", units="nondim", default=1.0) PI = 4.0*atan(1.0) ! Calculate the depth of the bottom. do j=js,je ; do i=is,ie x = (G%geoLonT(i,j)-G%west_lon) / G%len_lon - y =( G%geoLatT(i,j)-G%south_lat) / G%len_lat + y = (G%geoLatT(i,j)-G%south_lat) / G%len_lat ! This sets topography that has a reentrant channel to the south. D(i,j) = 1.0 - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) - & !< The great northern wall and Antarctica nl_top_amp*( & @@ -83,8 +84,8 @@ end subroutine Neverworld_initialize_topography !> Returns the value of a cosine-bell function evaluated at x/L real function cosbell(x, L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width + real , intent(in) :: x !< non-dimensional position [nondim] + real , intent(in) :: L !< non-dimensional width [nondim] real :: PI !< 3.1415926... calculated as 4*atan(1) PI = 4.0*atan(1.0) @@ -94,8 +95,8 @@ end function cosbell !> Returns the value of a sin-spike function evaluated at x/L real function spike(x, L) - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width + real , intent(in) :: x !< non-dimensional position [nondim] + real , intent(in) :: L !< non-dimensional width [nondim] real :: PI !< 3.1415926... calculated as 4*atan(1) PI = 4.0*atan(1.0) @@ -127,6 +128,8 @@ real function scurve(x, x0, L) scurve = ( 3. - 2.*s ) * ( s * s ) end function scurve +! None of the following 7 functions appear to be used. + !> Returns a "coastal" profile. real function cstprof(x, x0, L, lf, bf, sf, sh) real, intent(in) :: x !< non-dimensional coordinate [nondim] @@ -228,7 +231,7 @@ real function circ_ridge(lon, lat, lon0, lat0, ring_radius, ring_thickness, ridg r = sqrt( (lon - lon0)**2 + (lat - lat0)**2 ) ! Pseudo-distance from a point r = abs( r - ring_radius) ! Pseudo-distance from a circle r = cone(r, 0., ring_thickness, ridge_height) ! 0 .. frac_ridge_height - circ_ridge = 1. - r ! nondim depths (1-frac_ridge_height) .. 1 + circ_ridge = 1. - r ! Fractional depths (1-frac_ridge_height) .. 1 end function circ_ridge !> This subroutine initializes layer thicknesses for the Neverworld test case, @@ -253,10 +256,13 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, ! usually negative because it is positive upward. real, dimension(SZK_(GV)) :: h_profile ! Vector of initial thickness profile [Z ~> m]. real :: e_interface ! Current interface position [Z ~> m]. - real :: x,y,r1,r2 ! x,y and radial coordinates for computation of initial pert. - real :: pert_amp ! Amplitude of perturbations measured in Angstrom_H - real :: h_noise ! Amplitude of noise to scale h by - real :: noise ! Noise + real :: x, y ! horizontal coordinates for computation of the initial perturbation normalized + ! by the domain sizes [nondim] + real :: r1, r2 ! radial coordinates for computation of initial perturbation, normalized + ! by the domain sizes [nondim] + real :: pert_amp ! Amplitude of perturbations as a fraction of layer thicknesses [nondim] + real :: h_noise ! Amplitude of noise to scale h by [nondim] + real :: noise ! Fractional noise in the layer thicknesses [nondim] type(randomNumberStream) :: rns ! Random numbers for stochastic tidal parameterization character(len=40) :: mdl = "Neverworld_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz @@ -283,10 +289,10 @@ subroutine Neverworld_initialize_thickness(h, depth_tot, G, GV, US, param_file, 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 - y=(G%geoLatT(i,j)-G%south_lat)/G%len_lat - r1=sqrt((x-0.7)**2+(y-0.2)**2) - r2=sqrt((x-0.3)**2+(y-0.25)**2) + x = (G%geoLonT(i,j)-G%west_lon)/G%len_lon + y = (G%geoLatT(i,j)-G%south_lat)/G%len_lat + r1 = sqrt((x-0.7)**2+(y-0.2)**2) + r2 = sqrt((x-0.3)**2+(y-0.25)**2) h(i,j,k) = h(i,j,k) + pert_amp * (e0(k) - e0(nz+1)) * GV%Z_to_H * & (spike(r1,0.15)-spike(r2,0.15)) ! Prescribed perturbation if (h_noise /= 0.) then diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 97d26f7ee2..62b55bb0a1 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -68,7 +68,7 @@ subroutine Phillips_initialize_thickness(h, depth_tot, G, GV, US, param_file, ju if (.not.just_read) call log_version(param_file, mdl, version) call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The fractional depth where the stratification is centered.", & - units="nondim", default = 0.5, do_not_log=just_read) + units="nondim", default=0.5, do_not_log=just_read) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.not.just_read, do_not_log=just_read) @@ -233,16 +233,16 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< Thickness field [H ~> m or kg m-2]. ! Local variables - real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces. + real :: eta0(SZK_(GV)+1) ! The 1-d nominal positions of the interfaces [Z ~> m] 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. + real :: temp(SZI_(G),SZJ_(G),SZK_(GV)) ! A temporary array for other variables [various] real :: Idamp(SZI_(G),SZJ_(G)) ! The sponge damping rate [T-1 ~> s-1] real :: eta_im(SZJ_(G),SZK_(GV)+1) ! A temporary array for zonal-mean eta [Z ~> m]. real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate [T-1 ~> s-1]. real :: damp_rate ! The inverse zonal-mean damping rate [T-1 ~> s-1]. - real :: jet_width ! The width of the zonal mean jet, in km. + real :: jet_width ! The width of the zonal mean jet [km]. real :: jet_height ! The interface height scale associated with the zonal-mean jet [Z ~> m]. - real :: y_2 ! The y-position relative to the channel center, in km. + real :: y_2 ! The y-position relative to the channel center [km]. real :: half_strat ! The fractional depth where the straficiation is centered [nondim]. real :: half_depth ! The depth where the stratification is centered [Z ~> m]. real :: pi ! The ratio of the circumference of a circle to its diameter [nondim] @@ -262,10 +262,10 @@ subroutine Phillips_initialize_sponges(G, GV, US, tv, param_file, CSp, h) first_call = .false. call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The fractional depth where the stratificaiton is centered.", & - units="nondim", default = 0.5) + units="nondim", default=0.5) call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", & - units="s-1", default = 1.0/(10.0*86400.0), scale=US%T_to_s) + units="s-1", default=1.0/(10.0*86400.0), scale=US%T_to_s) call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & @@ -309,8 +309,8 @@ end subroutine Phillips_initialize_sponges !> sech calculates the hyperbolic secant. function sech(x) - real, intent(in) :: x !< Input value. - real :: sech !< Result. + real, intent(in) :: x !< Input value [nondim]. + real :: sech !< Result [nondim]. ! This is here to prevent overflows or underflows. if (abs(x) > 228.) then @@ -330,9 +330,14 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: PI, Htop, Wtop, Ltop, offset, dist - real :: x1, x2, x3, x4, y1, y2 - integer :: i,j,is,ie,js,je + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: Htop ! The maximum height of the topography above max_depth [Z ~> m] + real :: Wtop ! meridional width of topographic features [km] + real :: Ltop ! zonal width of topographic features [km] + real :: offset ! meridional offset from the center of topographic features [km] + real :: dist ! zonal width of topographic features [km] + real :: x1, x2, x3, x4, y1, y2 ! Various positions in the domain [km] + integer :: i, j, is, ie, js, je character(len=40) :: mdl = "Phillips_initialize_topography" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -349,10 +354,10 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) dist = 0.333*G%len_lon ! distance between drake and mount ! should be longer than Ltop/2 - y1=G%south_lat+0.5*G%len_lat+offset-0.5*Wtop; y2=y1+Wtop - x1=G%west_lon+0.1*G%len_lon; x2=x1+Ltop; x3=x1+dist; x4=x3+3.0/2.0*Ltop + y1 = G%south_lat+0.5*G%len_lat+offset-0.5*Wtop ; y2 = y1+Wtop + x1 = G%west_lon+0.1*G%len_lon ; x2 = x1+Ltop ; x3 = x1+dist ; x4 = x3+3.0/2.0*Ltop - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie D(i,j)=0.0 if (G%geoLonT(i,j)>x1 .and. G%geoLonT(i,j) m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -72,7 +72,6 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C real :: min_depth ! The minimum depth of the ocean [Z ~> m] real :: dummy1 ! The position relative to the sponge width [nondim] real :: min_thickness ! A minimum layer thickness [H ~> m or kg m-2] (unused) - real :: lenlat, lenlon ! The sizes of the domain [km] real :: lensponge ! The width of the sponge [km] character(len=40) :: filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir, h_var @@ -92,17 +91,9 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C call get_param(PF, mdl, "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, mdl, "LENLAT", lenlat, & - "The latitudinal or y-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - - call get_param(PF, mdl, "LENLON", lenlon, & - "The longitudinal or x-direction length of the domain", & - fail_if_missing=.true., do_not_log=.true.) - call get_param(PF, mdl, "LENSPONGE", lensponge, & - "The length of the sponge layer (km).", & - default=10.0) + "The length of the sponge layer.", & + units=G%x_ax_unit_short, default=10.0) call get_param(PF, mdl, "SPONGE_UV", sponge_uv, & "Nudge velocities (u and v) towards zero in the sponge layer.", & @@ -123,11 +114,11 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C ! will automatically set up the sponges only where Idamp is positive ! and mask2dT is 1. - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie 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) + elseif (G%geoLonT(i,j) >= (G%len_lon - lensponge) .AND. G%geoLonT(i,j) <= G%len_lon) then + dummy1 = (G%geoLonT(i,j)-(G%len_lon - lensponge))/(lensponge) Idamp(i,j) = (1.0/TNUDG) * max(0.0,dummy1) else Idamp(i,j) = 0.0 diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 2d0dcb85e5..9ff99b583f 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -47,9 +47,13 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read !! parameters without changing h. integer :: i, j, k, is, ie, js, je, nz - real :: Tz, Dml, eta, stretch, h0 - real :: min_thickness, T_range - real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] + real :: Tz ! Vertical temperature gradient [C Z-1 ~> degC m-1] + real :: Dml ! Mixed layer depth [Z ~> m] + real :: eta ! An interface height depth [Z ~> m] + real :: stretch ! A nondimensional stretching factor [nondim] + real :: h0 ! The stretched thickness per layer [Z ~> m] + real :: T_range ! Range of temperatures over the vertical [C ~> degC] + real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -59,13 +63,12 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read if (.not.just_read) call log_version(param_file, mdl, version, "") ! Read parameters needed to set thickness - call get_param(param_file, mdl, "MIN_THICKNESS", min_thickness, & - 'Minimum layer thickness',units='m',default=1.e-3, do_not_log=just_read) call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - units='C', default=0.0, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, scale=US%kg_m3_to_R, do_not_log=.true.) + units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, & + units="kg m-3 degC-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -76,7 +79,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read case (REGRIDDING_LAYER, REGRIDDING_RHO) do j = G%jsc,G%jec ; do i = G%isc,G%iec Dml = Hml( G, G%geoLatT(i,j) ) - eta = -( -dRho_DT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) + eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz @@ -87,7 +90,7 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read case (REGRIDDING_ZSTAR, REGRIDDING_SIGMA) do j = G%jsc,G%jec ; do i = G%isc,G%iec Dml = Hml( G, G%geoLatT(i,j) ) - eta = -( -dRho_DT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) + eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) stretch = ( ( G%max_depth + eta ) / G%max_depth ) h0 = ( G%max_depth / real(nz) ) * stretch do k = 1, nz @@ -118,15 +121,18 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & !! only read parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz - real :: T_ref, S_ref ! Reference salinity and temerature within surface layer - real :: T_range ! Range of salinities and temperatures over the vertical - real :: zc, zi, dTdz + real :: T_ref ! Reference temperature within the surface layer [C ~> degC] + real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] + real :: T_range ! Range of temperatures over the vertical [C ~> degC] + real :: zc ! Position of the middle of the cell [Z ~> m] + real :: zi ! Bottom interface position relative to the sea surface [H ~> m or kg m-2] + real :: dTdz ! Vertical temperature gradient [C Z-1 ~> degC m-1] character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & @@ -169,12 +175,13 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just logical, intent(in) :: just_read !< If present and true, this call will only !! read parameters without setting u & v. - real :: T_range ! Range of salinities and temperatures over the vertical - real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 degC-1 ~> m s-1 degC-1] - real :: dRho_dT ! The partial derivative of density with temperature [R degC-1 ~> kg m-3 degC-1] - real :: Dml, zi, zc, zm ! Depths [Z ~> m]. + real :: T_range ! Range of temperatures over the vertical [C ~> degC] + real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 C-1 ~> m s-1 degC-1] + real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: Dml ! Mixed layer depth [Z ~> m] + real :: zi, zc, zm ! Depths [Z ~> m]. real :: f ! The local Coriolis parameter [T-1 ~> s-1] - real :: Ty ! The meridional temperature gradient [degC L-1 ~> degC m-1] + real :: Ty ! The meridional temperature gradient [C L-1 ~> degC m-1] real :: hAtU ! Interpolated layer thickness [Z ~> m]. integer :: i, j, k, is, ie, js, je, nz character(len=40) :: verticalCoordinate @@ -184,8 +191,9 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & - units='C', default=0.0, do_not_log=just_read) - call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, scale=US%kg_m3_to_R, do_not_log=.true.) + units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, & + units='kg m-3 degC-1', default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -197,7 +205,7 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just dUdT = 0.0 ; if (abs(f) > 0.0) & dUdT = ( GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 ) Dml = Hml( G, G%geoLatT(i,j) ) - Ty = US%L_to_m*dTdy( G, T_range, G%geoLatT(i,j) ) + Ty = dTdy( G, T_range, G%geoLatT(i,j), US ) zi = 0. do k = 1, nz hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z @@ -212,12 +220,12 @@ end subroutine Rossby_front_initialize_velocity !> Pseudo coordinate across domain used by Hml() and dTdy() !! returns a coordinate from -PI/2 .. PI/2 squashed towards the -!! center of the domain. +!! center of the domain [radians]. real function yPseudo( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, intent(in) :: lat !< Latitude + real, intent(in) :: lat !< Latitude in arbitrary units, often [km] ! Local - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] PI = 4.0 * atan(1.0) yPseudo = ( ( lat - G%south_lat ) / G%len_lat ) - 0.5 ! -1/2 .. 1/.2 @@ -226,12 +234,12 @@ end function yPseudo !> Analytic prescription of mixed layer depth in 2d Rossby front test, -!! in the same units as G%max_depth +!! in the same units as G%max_depth (usually [Z ~> m]) real function Hml( G, lat ) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, intent(in) :: lat !< Latitude + real, intent(in) :: lat !< Latitude in arbitrary units, often [km] ! Local - real :: dHML, HMLmean + real :: dHML, HMLmean ! The range and mean of the mixed layer depths [Z ~> m] dHML = 0.5 * ( HMLmax - HMLmin ) * G%max_depth HMLmean = 0.5 * ( HMLmin + HMLmax ) * G%max_depth @@ -239,18 +247,22 @@ real function Hml( G, lat ) end function Hml -!> Analytic prescription of mixed layer temperature gradient in 2d Rossby front test -real function dTdy( G, dT, lat ) +!> Analytic prescription of mixed layer temperature gradient in [C L-1 ~> degC m-1] in 2d Rossby front test +real function dTdy( G, dT, lat, US ) type(ocean_grid_type), intent(in) :: G !< Grid structure - real, intent(in) :: dT !< Top to bottom temperature difference - real, intent(in) :: lat !< Latitude + real, intent(in) :: dT !< Top to bottom temperature difference [C ~> degC] + real, intent(in) :: lat !< Latitude in [km] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local - real :: PI, dHML, dHdy - real :: km = 1.e3 ! AXIS_UNITS = 'k' (1000 m) + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: dHML ! The range of the mixed layer depths [Z ~> m] + real :: dHdy ! The mixed layer depth gradient [Z L-1 ~> m m-1] + real :: km_to_L ! Horizontal axis unit conversion factor when AXIS_UNITS = 'k' (1000 m) [L km-1 ~> 1000] PI = 4.0 * atan(1.0) + km_to_L = 1.0e3*US%m_to_L dHML = 0.5 * ( HMLmax - HMLmin ) * G%max_depth - dHdy = dHML * ( PI / ( frontFractionalWidth * G%len_lat * km ) ) * cos( yPseudo(G, lat) ) + dHdy = dHML * ( PI / ( frontFractionalWidth * G%len_lat * km_to_L ) ) * cos( yPseudo(G, lat) ) dTdy = -( dT / G%max_depth ) * dHdy end function dTdy diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index f681231694..8df8f90e3d 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -197,7 +197,7 @@ subroutine SCM_CVMix_tests_wind_forcing(sfc_state, forces, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: mag_tau + real :: mag_tau ! The magnitude of the wind stress [R L Z T-2 ~> Pa] ! Bounds for loops and memory allocation is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -231,7 +231,7 @@ subroutine SCM_CVMix_tests_buoyancy_forcing(sfc_state, fluxes, day, G, US, CS) ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] PI = 4.0*atan(1.0) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 3509ef69d3..a958ebdebb 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -4,15 +4,15 @@ module adjustment_initialization ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE -use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR -use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE +use regrid_consts, only : REGRIDDING_LAYER, REGRIDDING_ZSTAR +use regrid_consts, only : REGRIDDING_RHO, REGRIDDING_SIGMA implicit none ; private @@ -46,18 +46,23 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. - ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. - real :: x, y, yy - real :: S_ref ! Reference salinity within surface layer [S ~> ppt] - real :: S_range ! Range of salinities in the vertical [S ~> ppt] - real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] - real :: delta_S ! The local salinity perturbation [S ~> ppt] - real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] - real :: min_thickness, adjustment_width, adjustment_delta - real :: adjustment_deltaS - real :: front_wave_amp, front_wave_length, front_wave_asym - real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] + real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. + ! In this subroutine it is hard coded at 1.0 kg m-3 ppt-1. + real :: x, y, yy ! Fractional positions in the x- and y-directions [nondim] + real :: y_lat ! y-positions in the units of latitude [m] or [km] or [degrees] + real :: S_ref ! Reference salinity within surface layer [S ~> ppt] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] + real :: delta_S ! The local salinity perturbation [S ~> ppt] + real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] + real :: min_thickness ! The minimum layer thickness [Z ~> m] + real :: adjustment_delta ! Interface height anomalies, positive downward [Z ~> m] + real :: adjustment_width ! Width of the frontal zone [m] or [km] or [degrees] + real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] + real :: front_wave_amp ! Amplitude of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_length ! Wave-length of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_asym ! Amplitude of frontal asymmetric perturbation [m] or [km] or [degrees] + real :: target_values(SZK_(GV)+1) ! Target densities or density anomalies [R ~> kg m-3] character(len=20) :: verticalCoordinate ! This include declares and sets the variable "version". # include "version_variable.h" @@ -72,30 +77,33 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & + call get_param(param_file, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & default=1.0e-3, units='m', scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DS", dRho_dS, & + "The partial derivative of density with salinity with a linear equation of state.", & + units="kg m-3 PSU-1", default=0.8, scale=US%kg_m3_to_R*US%S_to_ppt) ! Parameters specific to this experiment configuration - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) - call get_param(param_file, mdl,"ADJUSTMENT_WIDTH",adjustment_width, & + call get_param(param_file, mdl, "ADJUSTMENT_WIDTH", adjustment_width, & "Width of frontal zone", & - units="same as x,y", fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"DELTA_S_STRAT",delta_S_strat, & + units=G%x_ax_unit_short, fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "DELTA_S_STRAT", delta_S_strat, & "Top-to-bottom salinity difference of stratification", & units="1e-3", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"ADJUSTMENT_DELTAS",adjustment_deltaS, & + call get_param(param_file, mdl, "ADJUSTMENT_DELTAS", adjustment_deltaS, & "Salinity difference across front", & units="1e-3", scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"FRONT_WAVE_AMP",front_wave_amp, & + call get_param(param_file, mdl, "FRONT_WAVE_AMP", front_wave_amp, & "Amplitude of trans-frontal wave perturbation", & - units="same as x,y", default=0., do_not_log=just_read) - call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & + units=G%x_ax_unit_short, default=0., do_not_log=just_read) + call get_param(param_file, mdl, "FRONT_WAVE_LENGTH", front_wave_length, & "Wave-length of trans-frontal wave perturbation", & - units="same as x,y", default=0., do_not_log=just_read) - call get_param(param_file, mdl,"FRONT_WAVE_ASYM",front_wave_asym, & + units=G%x_ax_unit_short, default=0., do_not_log=just_read) + call get_param(param_file, mdl, "FRONT_WAVE_ASYM", front_wave_asym, & "Amplitude of frontal asymmetric perturbation", & - units="same as x,y", default=0., do_not_log=just_read) + units=G%x_ax_unit_short, default=0., do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -112,7 +120,6 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) - dRho_dS = 1.0*US%kg_m3_to_R*US%S_to_ppt if (delta_S_strat /= 0.) then ! This was previously coded ambiguously. adjustment_delta = (adjustment_deltaS / delta_S_strat) * G%max_depth @@ -142,11 +149,11 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read yy = 2. * ( G%geoLatT(i,j) - 0.5 * G%len_lat ) / adjustment_width yy = min(1.0, yy); yy = max(-1.0, yy) yy = yy * 2. * acos( 0. ) - y = front_wave_amp*sin(y) + front_wave_asym*sin(yy) + y_lat = front_wave_amp*sin(y) + front_wave_asym*sin(yy) else - y = 0. + y_lat = 0. endif - x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y ) / adjustment_width + x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y_lat ) / adjustment_width x = min(1.0, x); x = max(-1.0, x) x = x * acos( 0. ) delta_S = adjustment_deltaS * 0.5 * (1. - sin( x ) ) @@ -185,7 +192,7 @@ subroutine adjustment_initialize_thickness ( h, G, GV, US, param_file, just_read enddo ; enddo case default - call MOM_error(FATAL,"adjustment_initialize_thickness: "// & + call MOM_error(FATAL, "adjustment_initialize_thickness: "// & "Unrecognized i.c. setup - set ADJUSTMENT_IC") end select @@ -197,57 +204,63 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< The temperature that is being initialized [C ~> degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< The salinity that is being initialized [S ~> 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),SZK_(GV)), & + intent(out) :: T !< The temperature that is being initialized [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: S !< The salinity that is being initialized [S ~> 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 !< A structure indicating the open file to - !! parse for model parameter values. - logical, intent(in) :: just_read !< If true, this call will only read - !! parameters without changing T & S. - - integer :: i, j, k, is, ie, js, je, nz - real :: x, y, yy - real :: S_ref ! Reference salinity within surface layer [S ~> ppt] - real :: T_ref ! Reference temperature within surface layer [C ~> degC] - real :: S_range ! Range of salinities in the vertical [S ~> ppt] - real :: T_range ! Range of temperatures in the vertical [C ~> degC] - real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] - real :: delta_S ! The local salinity perturbation [S ~> ppt] - real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] - real :: adjustment_width - real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] - real :: front_wave_amp, front_wave_length, front_wave_asym - real :: eta1d(SZK_(GV)+1) ! Interface heights [Z ~> m] + 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) :: just_read !< If true, this call will only read + !! parameters without changing T & S. + + real :: x, y, yy ! Fractional positions in the x- and y-directions [nondim] + real :: y_lat ! y-position in the units of latitude [m] or [km] or [degrees] + real :: S_ref ! Reference salinity within surface layer [S ~> ppt] + real :: T_ref ! Reference temperature within surface layer [C ~> degC] + real :: S_range ! Range of salinities in the vertical [S ~> ppt] + real :: T_range ! Range of temperatures in the vertical [C ~> degC] + real :: dSdz ! Vertical salinity gradient [S Z-1 ~> ppt m-1] + real :: delta_S ! The local salinity perturbation [S ~> ppt] + real :: delta_S_strat ! Top-to-bottom salinity difference of stratification [S ~> ppt] + real :: adjustment_width ! Width of the frontal zone [m] or [km] or [degrees] + real :: adjustment_deltaS ! Salinity difference across front [S ~> ppt] + real :: front_wave_amp ! Amplitude of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_length ! Wave-length of trans-frontal wave perturbation [m] or [km] or [degrees] + real :: front_wave_asym ! Amplitude of frontal asymmetric perturbation [m] or [km] or [degrees] + real :: eta1d(SZK_(GV)+1) ! Interface heights [Z ~> m] character(len=20) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Parameters used by main model initialization call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"S_RANGE", S_range, 'Initial salinity range', & + call get_param(param_file, mdl, "S_RANGE", S_range, 'Initial salinity range', & default=2.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & - default=0.0, units='C', scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & + default=1.0, units='degC', scale=US%degC_to_C, do_not_log=just_read) ! Parameters specific to this experiment configuration BUT logged in previous s/r - call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) - call get_param(param_file, mdl,"ADJUSTMENT_WIDTH", adjustment_width, & - fail_if_missing=.not.just_read, do_not_log=.true.) - call get_param(param_file, mdl,"ADJUSTMENT_DELTAS", adjustment_deltaS, & + call get_param(param_file, mdl, "ADJUSTMENT_WIDTH", adjustment_width, & + units=G%x_ax_unit_short, fail_if_missing=.not.just_read, do_not_log=.true.) + call get_param(param_file, mdl, "ADJUSTMENT_DELTAS", adjustment_deltaS, & units='1e-3', scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=.true.) - call get_param(param_file, mdl,"DELTA_S_STRAT", delta_S_strat, & + call get_param(param_file, mdl, "DELTA_S_STRAT", delta_S_strat, & units='1e-3', scale=US%ppt_to_S, fail_if_missing=.not.just_read, do_not_log=.true.) - call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & - do_not_log=.true.) - call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & - default=0., do_not_log=.true.) - call get_param(param_file, mdl,"FRONT_WAVE_ASYM", front_wave_asym, default=0., & - do_not_log=.true.) + call get_param(param_file, mdl, "FRONT_WAVE_AMP", front_wave_amp, & + units=G%x_ax_unit_short, default=0., do_not_log=.true.) + call get_param(param_file, mdl, "FRONT_WAVE_LENGTH", front_wave_length, & + units=G%x_ax_unit_short, default=0., do_not_log=.true.) + call get_param(param_file, mdl, "FRONT_WAVE_ASYM", front_wave_asym, & + units=G%x_ax_unit_short, default=0., do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. @@ -269,11 +282,11 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, yy = 2. * ( G%geoLatT(i,j) - 0.5 * G%len_lat ) / front_wave_length yy = min(1.0, yy); yy = max(-1.0, yy) yy = yy * 2. * acos( 0. ) - y = front_wave_amp*sin(y) + front_wave_asym*sin(yy) + y_lat = front_wave_amp*sin(y) + front_wave_asym*sin(yy) else - y = 0. + y_lat = 0. endif - x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y ) / adjustment_width + x = ( ( G%geoLonT(i,j) - 0.5 * G%len_lon ) + y_lat ) / adjustment_width x = min(1.0, x); x = max(-1.0, x) x = x * acos( 0. ) delta_S = adjustment_deltaS * 0.5 * (1. - sin( x ) ) @@ -281,7 +294,7 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, S(i,j,k) = S_ref + delta_S + 0.5 * ( eta1D(k)+eta1D(k+1) ) * dSdz x = abs(S(i,j,k) - 0.5*real(nz-1)/real(nz)*S_range)/S_range*real(2*nz) x = 1. - min(1., x) - T(i,j,k) = US%degC_to_C * x + T(i,j,k) = T_range * x enddo ! x = GV%H_to_Z*sum(T(i,j,:)*h(i,j,:)) ! T(i,j,:) = (T(i,j,:) / x) * (G%max_depth*1.5/real(nz)) @@ -292,11 +305,11 @@ subroutine adjustment_initialize_temperature_salinity(T, S, h, depth_tot, G, GV, S(:,:,k) = S_ref + S_range * ( (real(k)-0.5) / real( nz ) ) ! x = abs(S(1,1,k) - 0.5*real(nz-1)/real(nz)*S_range)/S_range*real(2*nz) ! x = 1.-min(1., x) - ! T(:,:,k) = x + ! T(:,:,k) = T_range * x enddo case default - call MOM_error(FATAL,"adjustment_initialize_temperature_salinity: "// & + call MOM_error(FATAL, "adjustment_initialize_temperature_salinity: "// & "Unrecognized i.c. setup - set ADJUSTMENT_IC") end select diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index eb1f943b87..2ff4e1ec80 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -36,14 +36,17 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, real, intent(out) :: S_ref !< Reference salinity [S ~> ppt] real, intent(out) :: dSdz !< Salinity stratification [S Z-1 ~> ppt m-1] real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [S ~> ppt] - real, intent(out) :: dSdx !< Linear salinity gradient - !! in [S G%xaxis_units-1 ~> ppt G%xaxis_units-1] + real, intent(out) :: dSdx !< Linear salinity gradient, often in [S km-1 ~> ppt km-1] + !! or [S degrees_E-1 ~> ppt degrees_E-1], depending on + !! the value of G%x_axis_units real, intent(out) :: T_ref !< Reference temperature [C ~> degC] real, intent(out) :: dTdz !< Temperature stratification [C Z-1 ~> degC m-1] real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [C ~> degC] - real, intent(out) :: dTdx !< Linear temperature gradient - !! in [C G%x_axis_units-1 ~> degC G%x_axis_units-1] - real, intent(out) :: L_zone !< Width of baroclinic zone in [G%x_axis_units] + real, intent(out) :: dTdx !< Linear temperature gradient, often in [C km-1 ~> degC km-1] + !! or [C degrees_E-1 ~> degC degrees_E-1], depending on + !! the value of G%x_axis_units + real, intent(out) :: L_zone !< Width of baroclinic zone, often in [km] or [degrees_N], + !! depending on the value of G%y_axis_units logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing h. @@ -53,21 +56,21 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & units='ppt', default=35., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DSDZ", dSdz, 'Salinity stratification', & - units='ppt/m', default=0.0, scale=US%ppt_to_S*US%Z_to_m, do_not_log=just_read) - call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & + units='ppt m-1', default=0.0, scale=US%ppt_to_S*US%Z_to_m, do_not_log=just_read) + call get_param(param_file, mdl, "DELTA_S",delta_S, 'Salinity difference across baroclinic zone', & units='ppt', default=0.0, scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & - units='ppt/'//trim(G%x_axis_units), default=0.0, scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & - units='C', default=10., scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DSDX", dSdx,'Meridional salinity difference', & + units='ppt '//trim(G%x_ax_unit_short)//'-1', default=0.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & + units='degC', default=10., scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "DTDZ", dTdz, 'Temperature stratification', & - units='C/m', default=0.0, scale=US%degC_to_C*US%Z_to_m, do_not_log=just_read) - call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & - units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) - call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & - units='C/'//trim(G%x_axis_units), default=0.0, scale=US%degC_to_C, do_not_log=just_read) - call get_param(param_file, mdl,"L_ZONE",L_zone,'Width of baroclinic zone', & - units=G%x_axis_units, default=0.5*G%len_lat, do_not_log=just_read) + units='degC m-1', default=0.0, scale=US%degC_to_C*US%Z_to_m, do_not_log=just_read) + call get_param(param_file, mdl, "DELTA_T", delta_T,'Temperature difference across baroclinic zone', & + units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "DTDX", dTdx,'Meridional temperature difference', & + units='degC '//trim(G%x_ax_unit_short)//'-1', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "L_ZONE", L_zone, 'Width of baroclinic zone', & + units=G%y_ax_unit_short, default=0.5*G%len_lat, do_not_log=just_read) call closeParameterBlock(param_file) end subroutine bcz_params @@ -92,12 +95,20 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, depth_tot, G, GV, !! parameters without changing T & S. integer :: i, j, k, is, ie, js, je, nz - real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution [C ~> degC] - real :: S_ref, dSdz, dSdx, delta_S ! Parameters describing salinity distribution [S ~> ppt] - real :: L_zone ! Width of baroclinic zone in [G%axis_units] - real :: zc, zi ! Depths in depth units [Z ~> m] - real :: x, xd, xs, y, yd, fn - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: T_ref, delta_T ! Parameters describing temperature distribution [C ~> degC] + real :: dTdz ! Vertical temperature gradients [C Z-1 ~> degC m-1] + real :: dTdx ! Zonal temperature gradients [C axis_units-1 ~> degC axis_units-1] + real :: S_ref, delta_S ! Parameters describing salinity distribution [S ~> ppt] + real :: dSdz ! Vertical salinity gradients [S Z-1 ~> ppt m-1] + real :: dSdx ! Zonal salinity gradients [S axis_units-1 ~> ppt axis_units-1] + real :: L_zone ! Width of baroclinic zone, often in [km] or [degrees_N], depending + ! on the value of G%y_axis_units + real :: zc, zi ! Depths in depth units [Z ~> m] + real :: x ! X-position relative to the domain center [degrees_E] or [km] or [m] + real :: y ! Y-position relative to the domain center [degrees_N] or [km] or [m] + real :: fn ! A smooth function based on the position in the baroclinic zone [nondim] + real :: xs, xd, yd ! Fractional x- and y-positions relative to the domain extent [nondim] + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/user/basin_builder.F90 b/src/user/basin_builder.F90 index 9a4974807f..42083b2672 100644 --- a/src/user/basin_builder.F90 +++ b/src/user/basin_builder.F90 @@ -34,7 +34,7 @@ subroutine basin_builder_topography(D, G, param_file, max_depth) character(len=17) :: pname1, pname2 ! For construction of parameter names character(len=20) :: funcs ! Basin build function real, dimension(20) :: pars ! Parameters for each function - real :: lon ! Longitude [degrees_E} + real :: lon ! Longitude [degrees_E] real :: lat ! Latitude [degrees_N] integer :: i, j, n, n_funcs diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index 9ed2881563..3920b52729 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -41,7 +41,7 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) ! Local variables real :: min_depth ! The minimum basin depth [Z ~> m] - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] real :: x ! Longitude relative to the domain edge, normalized by its extent [nondim] real :: y ! Latitude relative to the domain edge, normalized by its extent [nondim] @@ -101,9 +101,11 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! in depth units [Z ~> m]. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. - real :: SST ! The initial sea surface temperature [C ~> degC]. - real :: T_int ! The initial temperature of an interface [C ~> degC]. - real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. + real :: SST ! The initial sea surface temperature [C ~> degC]. + real :: S_ref ! A default value for salinities [S ~> ppt] + real :: T_light ! A first guess at the temperature of the lightest layer [C ~> degC] + real :: T_int ! The initial temperature of an interface [C ~> degC]. + real :: ML_depth ! The specified initial mixed layer depth, in depth units [Z ~> m]. real :: thermocline_scale ! The e-folding scale of the thermocline, in depth units [Z ~> m]. real, dimension(SZK_(GV)) :: & T0, S0, & ! Profiles of temperature [C ~> degC] and salinity [S ~> ppt] @@ -111,7 +113,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e drho_dT, & ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1]. drho_dS ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa]. - real :: a_exp ! The fraction of the overall stratification that is exponential. + real :: a_exp ! The fraction of the overall stratification that is exponential [nondim] real :: I_ts, I_md ! Inverse lengthscales [Z-1 ~> m-1]. real :: T_frac ! A ratio of the interface temperature to the range ! between SST and the bottom temperature [nondim]. @@ -119,7 +121,7 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! interface temperature for a given z [nondim] real :: derr_dz ! The derivative of the normalized error between the profile's ! temperature and the interface temperature with z [Z-1 ~> m-1] - real :: pi ! 3.1415926... calculated as 4*atan(1) + real :: pi ! 3.1415926... calculated as 4*atan(1) [nondim] real :: z ! A work variable for the interface position [Z ~> m] ! This include declares and sets the variable "version". # include "version_variable.h" @@ -135,6 +137,12 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e call get_param(param_file, mdl, "BENCHMARK_THERMOCLINE_SCALE", thermocline_scale, & "Initial thermocline depth scale in the benchmark test case.", & default=500.0, units="m", scale=US%m_to_Z, do_not_log=just_read) + call get_param(param_file, mdl, "BENCHMARK_T_LIGHT", T_light, & + "A first guess at the temperature of the lightest layer in the benchmark test case.", & + units="degC", default=29.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_ref, & + "The uniform salinities used to initialize the benchmark test case.", & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=just_read) if (just_read) return ! This subroutine has no run-time parameters. @@ -147,9 +155,9 @@ subroutine benchmark_initialize_thickness(h, depth_tot, G, GV, US, param_file, e ! This block calculates T0(k) for the purpose of diagnosing where the ! interfaces will be found. do k=1,nz - pres(k) = P_Ref ; S0(k) = 35.0*US%ppt_to_S + pres(k) = P_Ref ; S0(k) = S_ref enddo - T0(k1) = 29.0*US%degC_to_C + T0(k1) = T_light call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) call calculate_density_derivs(T0(k1), S0(k1), pres(k1), drho_dT(k1), drho_dS(k1), eqn_of_state) @@ -232,25 +240,33 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & ! Local variables real :: T0(SZK_(GV)) ! A profile of temperatures [C ~> degC] real :: S0(SZK_(GV)) ! A profile of salinities [S ~> ppt] + real :: S_ref ! A default value for salinities [S ~> ppt] + real :: T_light ! A first guess at the temperature of the lightest layer [C ~> degC] real :: pres(SZK_(GV)) ! Reference pressure [R L2 T-2 ~> Pa] real :: drho_dT(SZK_(GV)) ! Derivative of density with temperature [R C-1 ~> kg m-3 degC-1] real :: drho_dS(SZK_(GV)) ! Derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] real :: rho_guess(SZK_(GV)) ! Potential density at T0 & S0 [R ~> kg m-3] - real :: PI ! 3.1415926... calculated as 4*atan(1) + real :: PI ! 3.1415926... calculated as 4*atan(1) [nondim] real :: SST ! The initial sea surface temperature [C ~> degC] + character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + call get_param(param_file, mdl, "S_REF", S_ref, & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "BENCHMARK_T_LIGHT", T_light, & + units="degC", default=29.0, scale=US%degC_to_C, do_not_log=.true.) + if (just_read) return ! All run-time parameters have been read, so return. k1 = GV%nk_rho_varies + 1 do k=1,nz - pres(k) = P_Ref ; S0(k) = 35.0*US%ppt_to_S + pres(k) = P_Ref ; S0(k) = S_ref enddo - T0(k1) = 29.0*US%degC_to_C + T0(k1) = T_light call calculate_density(T0(k1), S0(k1), pres(k1), rho_guess(k1), eqn_of_state) call calculate_density_derivs(T0, S0, pres, drho_dT, drho_dS, eqn_of_state, (/k1,k1/) ) @@ -268,12 +284,12 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, US, param_file, & enddo enddo - do k=1,nz ; do i=is,ie ; do j=js,je + do k=1,nz ; do j=js,je ; do i=is,ie T(i,j,k) = T0(k) S(i,j,k) = S0(k) enddo ; enddo ; enddo PI = 4.0*atan(1.0) - do i=is,ie ; do j=js,je + do j=js,je ; do i=is,ie SST = 0.5*(T0(k1)+T0(nz)) - 0.9*0.5*(T0(k1)-T0(nz)) * & cos(PI*(G%geoLatT(i,j)-G%south_lat)/(G%len_lat)) do k=1,k1-1 diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 9553aafafb..63c5c8a0d4 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -44,7 +44,12 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward, in depth units [Z ~> m]. real :: IC_amp ! The amplitude of the initial height displacement [H ~> m or kg m-2]. - real :: diskrad, rad, lonC, latC, xOffset + real :: diskrad ! Radius of the elevated disk [km] or [degrees] or [m] + real :: rad ! Distance from the center of the elevated disk [km] or [degrees] or [m] + real :: lonC ! The x-position of a point [km] or [degrees] or [m] + real :: latC ! The y-position of a point [km] or [degrees] or [m] + real :: xOffset ! The x-offset of the elevated disc center relative to the domain + ! center [km] or [degrees] or [m] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. @@ -59,12 +64,12 @@ subroutine circle_obcs_initialize_thickness(h, depth_tot, G, GV, param_file, jus ! Parameters read by cartesian grid initialization call get_param(param_file, mdl, "DISK_RADIUS", diskrad, & "The radius of the initially elevated disk in the "//& - "circle_obcs test case.", units=G%x_axis_units, & + "circle_obcs test case.", units=G%x_ax_unit_short, & fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "DISK_X_OFFSET", xOffset, & "The x-offset of the initially elevated disk in the "//& - "circle_obcs test case.", units=G%x_axis_units, & - default = 0.0, do_not_log=just_read) + "circle_obcs test case.", units=G%x_ax_unit_short, & + default=0.0, do_not_log=just_read) call get_param(param_file, mdl, "DISK_IC_AMPLITUDE", IC_amp, & "Initial amplitude of interface height displacements "//& "in the circle_obcs test case.", & diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index a81c400256..81aa4c2b3b 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -35,15 +35,18 @@ module dense_water_initialization subroutine dense_water_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables - real, dimension(5) :: domain_params ! nondimensional widths of all domain sections - real :: sill_frac, shelf_frac + real, dimension(5) :: domain_params ! nondimensional widths of all domain sections [nondim] + real :: sill_frac ! Depth of the sill separating downslope from upslope, as a fraction of + ! the basin depth [nondim] + real :: shelf_frac ! Depth of the shelf region accumulating dense water for overflow, + ! as a fraction the basin depth [nondim] + real :: x ! Horizontal position normalized by the domain width [nondim] integer :: i, j - real :: x call get_param(param_file, mdl, "DENSE_WATER_DOMAIN_PARAMS", domain_params, & "Fractional widths of all the domain sections for the dense water experiment.\n"//& @@ -106,8 +109,10 @@ subroutine dense_water_initialize_TS(G, GV, US, param_file, T, S, h, just_read) logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. ! Local variables - real :: mld, S_ref, S_range, T_ref - real :: zi, zmid + real :: mld ! The initial mixed layer depth as a fraction of the maximum depth [nondim] + real :: S_ref, S_range ! The reference salinity and its range in the initial conditions [S ~> ppt] + real :: T_ref ! The reference temperature [C ~> degC] + real :: zi, zmid ! Depths from the surface nondimensionalized by the maximum depth [nondim] integer :: i, j, k, nz nz = GV%ke @@ -160,43 +165,52 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, logical, intent(in) :: use_ALE !< ALE flag type(sponge_CS), pointer :: CSp !< Layered sponge control structure pointer type(ALE_sponge_CS), pointer :: ACSp !< ALE sponge control structure pointer + ! Local variables real :: west_sponge_time_scale, east_sponge_time_scale ! Sponge timescales [T ~> s] - real :: west_sponge_width, east_sponge_width + real :: west_sponge_width ! The fraction of the domain in which the western (outflow) sponge is active [nondim] + real :: east_sponge_width ! The fraction of the domain in which the eastern (outflow) sponge is active [nondim] real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: T ! sponge temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinity [S ~> ppt] real, dimension(SZK_(GV)+1) :: e0, eta1D ! interface positions for ALE sponge [Z ~> m] - + real :: x ! Horizontal position normalized by the domain width [nondim] + real :: zi, zmid ! Depths from the surface nondimensionalized by the maximum depth [nondim] + real :: dist ! Distance from the edge of a sponge normalized by the width of that sponge [nondim] + real :: mld ! The initial mixed layer depth as a fraction of the maximum depth [nondim] + real :: S_ref, S_range ! The reference salinity and its range in the initial conditions [S ~> ppt] + real :: S_dense ! The salinity of the dense water being formed on the shelf [S ~> ppt] + real :: T_ref ! The reference temperature [C ~> degC] + real :: sill_frac ! Fractional depths of the sill, relative to the maximum depth [nondim] integer :: i, j, k, nz - real :: x, zi, zmid, dist - real :: mld, S_ref, S_range, S_dense, T_ref, sill_height nz = GV%ke call get_param(param_file, mdl, "DENSE_WATER_WEST_SPONGE_TIME_SCALE", west_sponge_time_scale, & - "The time scale on the west (outflow) of the domain for restoring. If zero, the sponge is disabled.", & - units="s", default=0., scale=US%s_to_T) + "The time scale on the west (outflow) of the domain for restoring. "//& + "If zero, the sponge is disabled.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "DENSE_WATER_WEST_SPONGE_WIDTH", west_sponge_width, & - "The fraction of the domain in which the western (outflow) sponge is active.", & - units="nondim", default=0.1) + "The fraction of the domain in which the western (outflow) sponge is active.", & + units="nondim", default=0.1) call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_TIME_SCALE", east_sponge_time_scale, & - "The time scale on the east (outflow) of the domain for restoring. If zero, the sponge is disabled.", & - units="s", default=0., scale=US%s_to_T) + "The time scale on the east (outflow) of the domain for restoring. "//& + "If zero, the sponge is disabled.", units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_WIDTH", east_sponge_width, & - "The fraction of the domain in which the eastern (outflow) sponge is active.", & - units="nondim", default=0.1) - + "The fraction of the domain in which the eastern (outflow) sponge is active.", & + units="nondim", default=0.1) call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_SALT", S_dense, & - "Salt anomaly of the dense water being formed in the overflow region.", & - units="1e-3", default=4.0) + "Salt anomaly of the dense water being formed in the overflow region.", & + units="1e-3", default=4.0, scale=US%ppt_to_S) - call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, default=default_mld, do_not_log=.true.) - call get_param(param_file, mdl, "DENSE_WATER_SILL_HEIGHT", sill_height, default=default_sill, do_not_log=.true.) + call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, & + units="nondim", default=default_mld, do_not_log=.true.) + call get_param(param_file, mdl, "DENSE_WATER_SILL_DEPTH", sill_frac, & + units="nondim", default=default_sill, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "S_RANGE", S_range, & units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "T_REF", T_ref, & @@ -266,12 +280,12 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, zmid = zi + 0.5 * h(i,j,k) / (GV%Z_to_H * G%max_depth) if (x > (1. - east_sponge_width)) then - !if (zmid >= 0.9 * sill_height) & - S(i,j,k) = S_ref + S_dense + !if (zmid >= 0.9 * sill_frac) & + S(i,j,k) = S_ref + S_dense else ! linear between bottom of mixed layer and bottom if (zmid >= mld) & - S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) + S(i,j,k) = S_ref + S_range * (zmid - mld) / (1.0 - mld) endif zi = zi + h(i,j,k) / (GV%Z_to_H * G%max_depth) @@ -300,7 +314,7 @@ end module dense_water_initialization !! The nondimensional widths of the 5 regions are controlled by the !! DENSE_WATER_DOMAIN_PARAMS, and the heights of the sill and shelf !! as a fraction of the total domain depth are controlled by -!! DENSE_WATER_SILL_HEIGHT and DENSE_WATER_SHELF_HEIGHT. +!! DENSE_WATER_SILL_DEPTH and DENSE_WATER_SHELF_DEPTH. !! !! The density in the domain is governed by a linear equation of state, and !! is set up with a mixed layer of non-dimensional depth DENSE_WATER_MLD diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index 762477b6c4..0b65883eca 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -41,27 +41,29 @@ module dumbbell_initialization subroutine dumbbell_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables - integer :: i, j - real :: x, y, dblen, dbfrac - logical :: dbrotate + real :: x, y ! Fractional x- and y- positions [nondim] + real :: dblen ! Lateral length scale for dumbbell [km] or [m] + real :: dbfrac ! Meridional fraction for narrow part of dumbbell [nondim] + logical :: dbrotate ! If true, rotate this configuration + integer :: i, j - call get_param(param_file, mdl, "DUMBBELL_LEN",dblen, & + call get_param(param_file, mdl, "DUMBBELL_LEN", dblen, & 'Lateral Length scale for dumbbell.', & - units='km', default=600., do_not_log=.false.) - call get_param(param_file, mdl, "DUMBBELL_FRACTION",dbfrac, & + units=G%x_ax_unit_short, default=600., do_not_log=.false.) + call get_param(param_file, mdl, "DUMBBELL_FRACTION", dbfrac, & 'Meridional fraction for narrow part of dumbbell.', & units='nondim', default=0.5, do_not_log=.false.) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=.false.) + default=.false., do_not_log=.false.) - if (G%x_axis_units == 'm') then - dblen=dblen*1.e3 + if (G%x_axis_units(1:1) == 'm') then + dblen = dblen*1.e3 endif if (dbrotate) then @@ -107,11 +109,12 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_ref ! A default value for salinities [ppt]. + real :: S_ref ! A default value for salinities [S ~> ppt]. real :: S_surf ! The surface salinity [S ~> ppt] real :: S_range ! The range of salinities in this test case [S ~> ppt] real :: S_light, S_dense ! The lightest and densest salinities in the sponges [S ~> ppt]. - real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. + real :: eta_IC_quanta ! The granularity of quantization of initial interface heights [Z-1 ~> m-1]. + real :: x ! Along-channel position in the axis units [m] or [km] or [deg] logical :: dbrotate ! If true, rotate the domain. logical :: use_ALE ! True if ALE is being used, False if in layered mode @@ -119,7 +122,6 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, # include "version_variable.h" character(len=20) :: verticalCoordinate integer :: i, j, k, is, ie, js, je, nz - real :: x, y is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -150,10 +152,10 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, case ( REGRIDDING_LAYER) ! Initial thicknesses for isopycnal coordinates call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=just_read) + default=.false., do_not_log=just_read) do j=js,je do i=is,ie - ! Compute normalized zonal coordinates (x,y=0 at center of domain) + ! Compute normalized zonal coordinates (x,y=0 at center of domain) if (dbrotate) then ! This is really y in the rotated case x = G%geoLatT(i,j) @@ -174,18 +176,20 @@ subroutine dumbbell_initialize_thickness ( h, depth_tot, G, GV, US, param_file, do k=1,nz h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) enddo - enddo; enddo + enddo + enddo case ( REGRIDDING_RHO, REGRIDDING_HYCOM1) ! Initial thicknesses for isopycnal coordinates call get_param(param_file, mdl, "INITIAL_SSS", S_surf, & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INITIAL_S_RANGE", S_range, & units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units='1e-3', default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - units='1e-3', default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units='1e-3', default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - units='1e-3', default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units='1e-3', default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & @@ -263,15 +267,13 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ real :: S_range ! The range of salinities in this test case [S ~> ppt] real :: T_surf ! The surface temperature [C ~> degC] real :: x ! The fractional position in the domain [nondim] - real :: dblen ! The size of the dumbbell test case [axis_units] + real :: dblen ! The size of the dumbbell test case [km] or [m] logical :: dbrotate ! If true, rotate the domain. - logical :: use_ALE ! If false, use layer mode. + logical :: use_ALE ! If false, use layer mode. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - T_surf = 20.0*US%degC_to_C - ! layer mode call get_param(param_file, mdl, "USE_REGRIDDING", use_ALE, default=.false., do_not_log=.true.) if (.not. use_ALE) call MOM_error(FATAL, "dumbbell_initialize_temperature_salinity: "//& @@ -282,6 +284,9 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ call get_param(param_file, mdl, "INITIAL_DENSITY_PROFILE", density_profile, & 'Initial profile shape. Valid values are "linear", "parabolic" '// & 'and "exponential".', default='linear', do_not_log=just_read) + call get_param(param_file, mdl, "DUMBBELL_T_SURF", T_surf, & + 'Initial surface temperature in the DUMBBELL configuration', & + units='degC', default=20., scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_SREF", S_surf, & 'DUMBBELL REFERENCE SALINITY', & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=just_read) @@ -289,13 +294,13 @@ subroutine dumbbell_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ 'DUMBBELL salinity range (right-left)', & units='1e-3', default=2., scale=US%ppt_to_S, do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_LEN", dblen, & - 'Lateral Length scale for dumbbell ', & - units='km', default=600., do_not_log=just_read) + 'Lateral Length scale for dumbbell ', & + units=G%x_ax_unit_short, default=600., do_not_log=just_read) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=just_read) + default=.false., do_not_log=just_read) - if (G%x_axis_units == 'm') then + if (G%x_axis_units(1:1) == 'm') then dblen = dblen*1.e3 endif @@ -346,12 +351,12 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil real, dimension(SZI_(G),SZJ_(G)) :: Idamp ! inverse damping timescale [T-1 ~> s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h ! sponge thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: S ! sponge salinities [S ~> ppt] - real, dimension(SZK_(GV)+1) :: eta1D ! interface positions for ALE sponge + real, dimension(SZK_(GV)+1) :: eta1D ! Interface positions for ALE sponge [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! A temporary array for interface heights [Z ~> m]. integer :: i, j, k, nz real :: x ! The fractional position in the domain [nondim] - real :: dblen ! The size of the dumbbell test case [axis_units] + real :: dblen ! The size of the dumbbell test case [km] or [m] real :: min_thickness ! The minimum layer thickness [Z ~> m] real :: S_ref, S_range ! A reference salinity and the range of salinities in this test case [S ~> ppt] logical :: dbrotate ! If true, rotate the domain. @@ -361,17 +366,17 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil units='km', default=600., do_not_log=.true.) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.', & - units='nondim', default=.false., do_not_log=.true.) + default=.false., do_not_log=.true.) - if (G%x_axis_units == 'm') then - dblen=dblen*1.e3 + if (G%x_axis_units(1:1) == 'm') then + dblen = dblen*1.e3 endif nz = GV%ke call get_param(param_file, mdl, "DUMBBELL_SPONGE_TIME_SCALE", sponge_time_scale, & - "The time scale in the reservoir for restoring. If zero, the sponge is disabled.", & - units="s", default=0., scale=US%s_to_T) + "The time scale in the reservoir for restoring. If zero, the sponge is disabled.", & + units="s", default=0., scale=US%s_to_T) call get_param(param_file, mdl, "DUMBBELL_SREF", S_ref, & 'DUMBBELL REFERENCE SALINITY', & units='1e-3', default=34., scale=US%ppt_to_S, do_not_log=.true.) @@ -448,7 +453,7 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil enddo ; enddo if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & sp_long_name='salinity', sp_unit='g kg-1 s-1') - else + else do j=G%jsc,G%jec ; do i=G%isc,G%iec eta(i,j,1) = 0.0 do k=2,nz @@ -466,8 +471,8 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil ! The remaining calls to set_up_sponge_field can be in any order. ! if ( associated(tv%S) ) call set_up_sponge_field(S, tv%S, G, GV, nz, CSp) - endif + endif end subroutine dumbbell_initialize_sponges -end module dumbbell_initialization \ No newline at end of file +end module dumbbell_initialization diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index a672a4378b..4ac5ab3bf9 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -34,7 +34,7 @@ module dumbbell_surface_forcing !! to the reservoirs real :: slp_period !< Period of sinusoidal pressure wave [days] real, dimension(:,:), allocatable :: & - forcing_mask !< A mask regulating where forcing occurs + forcing_mask !< A mask regulating where forcing occurs [nondim] real, dimension(:,:), allocatable :: & S_restore !< The surface salinity field toward which to restore [S ~> ppt]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the @@ -201,7 +201,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & - units="m s-2", default = 9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) + units="m s-2", default=9.80, scale=US%m_to_L**2*US%Z_to_m*US%T_to_s**2) call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to "//& "calculate accelerations and the mass for conservation "//& @@ -210,13 +210,13 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) units="kg m-3", default=1035.0, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "DUMBBELL_SLP_AMP", CS%slp_amplitude, & "Amplitude of SLP forcing in reservoirs.", & - units="Pa", default = 10000.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) + units="Pa", default=10000.0, scale=US%kg_m3_to_R*US%m_s_to_L_T**2) call get_param(param_file, mdl, "DUMBBELL_SLP_PERIOD", CS%slp_period, & "Periodicity of SLP forcing in reservoirs.", & units="days", default=1.0) call get_param(param_file, mdl, "DUMBBELL_ROTATION", dbrotate, & 'Logical for rotation of dumbbell domain.',& - units='nondim', default=.false., do_not_log=.true.) + default=.false., do_not_log=.true.) call get_param(param_file, mdl,"INITIAL_SSS", S_surf, & "Initial surface salinity", & units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=.true.) diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 411ab6ef98..aed7142fad 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -94,7 +94,7 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) character(len=40) :: mdl = "dyed_channel_set_OBC_tracer_data" ! This subroutine's name. character(len=80) :: name, longname integer :: m, n - real :: dye + real :: dye ! Inflow dye concentrations [arbitrary] type(tracer_type), pointer :: tr_ptr => NULL() if (.not.associated(OBC)) call MOM_error(FATAL, 'dyed_channel_initialization.F90: '// & @@ -142,7 +142,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, GV, US, Time) type(time_type), intent(in) :: Time !< model time. ! Local variables real :: flow ! The OBC velocity [L T-1 ~> m s-1] - real :: PI ! 3.1415926535... + real :: PI ! 3.1415926535... [nondim] real :: time_sec ! The elapsed time since the start of the calendar [T ~> s] integer :: i, j, k, l, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB diff --git a/src/user/dyed_obcs_initialization.F90 b/src/user/dyed_obcs_initialization.F90 index c5efef4905..6248efab2f 100644 --- a/src/user/dyed_obcs_initialization.F90 +++ b/src/user/dyed_obcs_initialization.F90 @@ -41,7 +41,7 @@ subroutine dyed_obcs_set_OBC_data(OBC, G, GV, param_file, tr_Reg) character(len=80) :: name, longname integer :: is, ie, js, je, isd, ied, jsd, jed, m, n, nz integer :: IsdB, IedB, JsdB, JedB - real :: dye + real :: dye ! Inflow dye concentration [arbitrary] type(tracer_type), pointer :: tr_ptr => NULL() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index ec507e181b..63cc89342a 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -39,12 +39,13 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! positive upward [Z ~> m]. real :: ssh_anomaly_height ! Vertical height of ssh anomaly [Z ~> m] - real :: ssh_anomaly_width ! Lateral width of anomaly [degrees] + real :: ssh_anomaly_width ! Lateral width of anomaly, often in [km] or [degrees_E] character(len=40) :: mdl = "external_gwave_initialize_thickness" ! This subroutine's name. ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz - real :: PI, Xnondim + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] + real :: Xnondim ! A normalized x position [nondim] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -53,11 +54,11 @@ subroutine external_gwave_initialize_thickness(h, G, GV, US, param_file, just_re if (.not.just_read) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & - "The vertical displacement of the SSH anomaly. ", units="m", scale=US%m_to_Z, & - fail_if_missing=.not.just_read, do_not_log=just_read) + "The vertical displacement of the SSH anomaly. ", & + units="m", scale=US%m_to_Z, fail_if_missing=.not.just_read, do_not_log=just_read) call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & - "The lateral width of the SSH anomaly. ", units="coordinate", & - fail_if_missing=.not.just_read, do_not_log=just_read) + "The lateral width of the SSH anomaly. ", & + units=G%x_ax_unit_short, fail_if_missing=.not.just_read, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index a3418e6482..3b41237c36 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -36,8 +36,8 @@ subroutine lock_exchange_initialize_thickness(h, G, GV, US, param_file, just_rea real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! positive upward [Z ~> m]. - real :: front_displacement ! Vertical displacement acrodd front - real :: thermocline_thickness ! Thickness of stratified region + real :: front_displacement ! Vertical displacement across front [Z ~> m] + real :: thermocline_thickness ! Thickness of stratified region [Z ~> m] ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "lock_exchange_initialize_thickness" ! This subroutine's name. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 5b62993551..a1f978a784 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -40,25 +40,28 @@ module seamount_initialization subroutine seamount_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables + real :: delta ! Height of the seamount as a fraction of the maximum ocean depth [nondim] + real :: x, y ! Normalized positions relative to the domain center [nondim] + real :: Lx, Ly ! Seamount length scales normalized by the relevant domain sizes [nondim] + real :: rLx, rLy ! The Adcroft reciprocals of Lx and Ly [nondim] integer :: i, j - real :: x, y, delta, Lx, rLx, Ly, rLy - call get_param(param_file, mdl,"SEAMOUNT_DELTA",delta, & + call get_param(param_file, mdl,"SEAMOUNT_DELTA", delta, & "Non-dimensional height of seamount.", & - units="non-dim", default=0.5) - call get_param(param_file, mdl,"SEAMOUNT_X_LENGTH_SCALE",Lx, & + units="nondim", default=0.5) + call get_param(param_file, mdl,"SEAMOUNT_X_LENGTH_SCALE", Lx, & "Length scale of seamount in x-direction. "//& "Set to zero make topography uniform in the x-direction.", & - units="Same as x,y", default=20.) - call get_param(param_file, mdl,"SEAMOUNT_Y_LENGTH_SCALE",Ly, & + units=G%x_ax_unit_short, default=20.) + call get_param(param_file, mdl,"SEAMOUNT_Y_LENGTH_SCALE", Ly, & "Length scale of seamount in y-direction. "//& "Set to zero make topography uniform in the y-direction.", & - units="Same as x,y", default=0.) + units=G%y_ax_unit_short, default=0.) Lx = Lx / G%len_lon Ly = Ly / G%len_lat @@ -93,7 +96,7 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j ! negative because it is positive upward. real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface, positive upward [Z ~> m] real :: min_thickness ! The minimum layer thicknesses [Z ~> m]. - real :: S_ref ! A default value for salinities [ppt]. + real :: S_ref ! A default value for salinities [S ~> ppt]. real :: S_surf, S_range, S_light, S_dense ! Various salinities [S ~> ppt]. real :: eta_IC_quanta ! The granularity of quantization of intial interface heights [Z-1 ~> m-1]. character(len=20) :: verticalCoordinate @@ -128,11 +131,12 @@ subroutine seamount_initialize_thickness (h, depth_tot, G, GV, US, param_file, j units="ppt", default=34., scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, & units="ppt", default=2., scale=US%ppt_to_S, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units="ppt", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="ppt", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - units="ppt", default=S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="ppt", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "INTERFACE_IC_QUANTA", eta_IC_quanta, & "The granularity of initial interface height values "//& "per meter, to avoid sensivity to order-of-arithmetic changes.", & @@ -205,9 +209,19 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi !! only read parameters without changing T & S. ! Local variables + real :: xi0, xi1 ! Fractional positions within the depth range [nondim] + real :: r ! A nondimensional sharpness parameter with an exponetial profile [nondim] + real :: S_Ref ! Default salinity range parameters [S ~> ppt]. + real :: T_Ref ! Default temperature range parameters [C ~> degC]. + real :: S_Light, S_Dense, S_surf, S_range ! Salinity range parameters [S ~> ppt]. + real :: T_Light, T_Dense, T_surf, T_range ! Temperature range parameters [C ~> degC]. + real :: res_rat ! The ratio of density space resolution in the denser part + ! of the range to that in the lighter part of the range. + ! Setting this greater than 1 increases the resolution for + ! the denser water [nondim]. + real :: a1, frac_dense, k_frac ! Nondimensional temporary variables [nondim] integer :: i, j, k, is, ie, js, je, nz, k_light - real :: xi0, xi1, r, S_surf, T_surf, S_range, T_range - real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat + character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -233,17 +247,20 @@ subroutine seamount_initialize_temperature_salinity(T, S, h, G, GV, US, param_fi select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER ) ! Initial thicknesses for layer isopycnal coordinates ! These parameters are used in MOM_fixed_initialization.F90 when CONFIG_COORD="ts_range" - call get_param(param_file, mdl, "T_REF", T_ref, default=10.0, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, & + units="degC", default=10.0, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_light, & - default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_dense, & - default=T_Ref, scale=US%degC_to_C, do_not_log=.true.) - call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + units="degC", default=US%C_to_degC*T_Ref, scale=US%degC_to_C, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, & + units="1e-3", default=35.0, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, & - default = S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + units="1e-3", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, & - default = S_Ref, scale=US%ppt_to_S, do_not_log=.true.) - call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, default=1.0, do_not_log=.true.) + units="1e-3", default=US%S_to_ppt*S_Ref, scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & + units="nondim", default=1.0, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. ! Emulate the T,S used in the "ts_range" coordinate configuration code diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index a9c1914356..df46a142f1 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -28,28 +28,30 @@ module shelfwave_initialization !> Control structure for shelfwave open boundaries. type, public :: shelfwave_OBC_CS ; private - real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] - real :: Ly = 50.0 !< Cross-shore length scale [km] - real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] - real :: jj = 1 !< Cross-shore wave mode. - real :: kk !< Parameter. - real :: ll !< Longshore wavenumber. - real :: alpha !< 1/Ly. - real :: omega !< Frequency of the shelf wave [T-1 ~> s-1] + real :: my_amp !< Amplitude of the open boundary current inflows [L T-1 ~> m s-1] + real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] or [m] + real :: Ly = 50.0 !< Cross-shore length scale [km] or [m] + real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] + real :: jj = 1.0 !< Cross-shore wave mode [nondim] + real :: kk !< Cross-shore wavenumber [km-1] or [m-1] + real :: ll !< Longshore wavenumber [km-1] or [m-1] + real :: alpha !< Exponential decay rate in the y-direction [km-1] or [m-1] + real :: omega !< Frequency of the shelf wave [T-1 ~> s-1] end type shelfwave_OBC_CS contains !> Add shelfwave to OBC registry. -function register_shelfwave_OBC(param_file, CS, US, OBC_Reg) +function register_shelfwave_OBC(param_file, CS, G, US, OBC_Reg) type(param_file_type), intent(in) :: param_file !< parameter file. type(shelfwave_OBC_CS), pointer :: CS !< shelfwave control structure. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. + type(OBC_registry_type), pointer :: OBC_Reg !< Open boundary condition registry. logical :: register_shelfwave_OBC - ! Local variables - real :: PI, len_lat + ! Local variables + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] character(len=32) :: casename = "shelfwave" !< This case's name. PI = 4.0*atan(1.0) @@ -65,23 +67,22 @@ function register_shelfwave_OBC(param_file, CS, US, OBC_Reg) call register_OBC(casename, param_file, OBC_Reg) call get_param(param_file, mdl, "F_0", CS%f0, & default=0.0, units="s-1", scale=US%T_to_s, do_not_log=.true.) - call get_param(param_file, mdl, "LENLAT", len_lat, & - do_not_log=.true., fail_if_missing=.true.) - call get_param(param_file, mdl,"SHELFWAVE_X_WAVELENGTH",CS%Lx, & + call get_param(param_file, mdl,"SHELFWAVE_X_WAVELENGTH", CS%Lx, & "Length scale of shelfwave in x-direction.",& - units="Same as x,y", default=100.) -! units="km", default=100.0, scale=1.0e3*US%m_to_L) + units=G%x_ax_unit_short, default=100.) call get_param(param_file, mdl, "SHELFWAVE_Y_LENGTH_SCALE", CS%Ly, & - "Length scale of exponential dropoff of topography "//& - "in the y-direction.", & - units="Same as x,y", default=50.) -! units="km", default=50.0, scale=1.0e3*US%m_to_L) + "Length scale of exponential dropoff of topography in the y-direction.", & + units=G%y_ax_unit_short, default=50.) call get_param(param_file, mdl, "SHELFWAVE_Y_MODE", CS%jj, & "Cross-shore wave mode.", & units="nondim", default=1.) + call get_param(param_file, mdl, "SHELFWAVE_AMPLITUDE", CS%my_amp, & + "Amplitude of the open boundary current inflows in the shelfwave configuration.", & + units="m s-1", default=1.0, scale=US%m_s_to_L_T) + CS%alpha = 1. / CS%Ly CS%ll = 2. * PI / CS%Lx - CS%kk = CS%jj * PI / len_lat + CS%kk = CS%jj * PI / G%len_lat CS%omega = 2 * CS%alpha * CS%f0 * CS%ll / & (CS%kk*CS%kk + CS%alpha*CS%alpha + CS%ll*CS%ll) register_shelfwave_OBC = .true. @@ -107,13 +108,16 @@ subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables + real :: y ! Position relative to the southern boundary [km] or [m] or [degrees_N] + real :: rLy ! Exponential decay rate of the topography [km-1] or [m-1] or [degrees_N-1] + real :: Ly ! Exponential decay lengthscale of the topography [km] or [m] or [degrees_N] + real :: H0 ! The minimum depth of the ocean [Z ~> m] integer :: i, j - real :: y, rLy, Ly, H0 - call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & - default=50., do_not_log=.true.) + call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE", Ly, & + units=G%y_ax_unit_short, default=50., do_not_log=.true.) call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & - default=10., units="m", scale=US%m_to_Z, do_not_log=.true.) + units="m", default=10., scale=US%m_to_Z, do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly @@ -134,16 +138,14 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the shelfwave example. - real :: my_amp ! Amplitude of the open boundary current inflows [L T-1 ~> m s-1] real :: time_sec ! The time in the run [T ~> s] - real :: cos_wt, cos_ky, sin_wt, sin_ky - real :: omega ! Frequency of the shelf wave [T-1 ~> s-1] - real :: alpha - real :: x, y, jj, kk, ll + real :: cos_wt, sin_wt ! Cosine and sine associated with the propagating x-direction structure [nondim] + real :: cos_ky, sin_ky ! Cosine and sine associated with the y-direction structure [nondim] + real :: x, y ! Positions relative to the western and southern boundaries [km] or [m] or [degrees] integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, n integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment => NULL() @@ -155,12 +157,6 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) if (.not.associated(OBC)) return time_sec = US%s_to_T*time_type_to_real(Time) - omega = CS%omega - alpha = CS%alpha - my_amp = 1.0*US%m_s_to_L_T - jj = CS%jj - kk = CS%kk - ll = CS%ll do n = 1, OBC%number_of_segments segment => OBC%segment(n) if (.not. segment%on_pe) cycle @@ -171,15 +167,15 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) do j=jsd,jed ; do I=IsdB,IedB x = G%geoLonCu(I,j) - G%west_lon y = G%geoLatCu(I,j) - G%south_lat - sin_wt = sin(ll*x - omega*time_sec) - cos_wt = cos(ll*x - omega*time_sec) - sin_ky = sin(kk * y) - cos_ky = cos(kk * y) - segment%normal_vel_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * & - (alpha * sin_ky + kk * cos_ky) -! segment%tangential_vel_bt(I,j) = my_amp * ll * exp(- alpha * y) * sin_wt * sin_ky -! segment%vorticity_bt(I,j) = my_amp * exp(- alpha * y) * cos_wt * sin_ky& -! (ll*ll + kk*kk + alpha*alpha) + sin_wt = sin(CS%ll*x - CS%omega*time_sec) + cos_wt = cos(CS%ll*x - CS%omega*time_sec) + sin_ky = sin(CS%kk * y) + cos_ky = cos(CS%kk * y) + segment%normal_vel_bt(I,j) = CS%my_amp * exp(- CS%alpha * y) * cos_wt * & + (CS%alpha * sin_ky + CS%kk * cos_ky) +! segment%tangential_vel_bt(I,j) = CS%my_amp * CS%ll * exp(- CS%alpha * y) * sin_wt * sin_ky +! segment%vorticity_bt(I,j) = CS%my_amp * exp(- CS%alpha * y) * cos_wt * sin_ky& +! (CS%ll**2 + CS%kk**2 + CS%alpha**2) enddo ; enddo enddo diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index de7869511b..357f247896 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -30,9 +30,9 @@ module sloshing_initialization subroutine sloshing_initialize_topography( D, G, param_file, max_depth ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in the units of depth_max + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum ocean depth in arbitrary units + real, intent(in) :: max_depth !< Maximum ocean depth [Z ~> m] ! Local variables integer :: i, j @@ -60,23 +60,22 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, 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, intent(in) :: just_read !< If true, this call will - !! only read parameters without changing h. + type(param_file_type), intent(in) :: param_file !< A structure to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. + ! Local variables real :: displ(SZK_(GV)+1) ! The interface displacement [Z ~> m]. real :: z_unif(SZK_(GV)+1) ! Fractional uniform interface heights [nondim]. real :: z_inter(SZK_(GV)+1) ! Interface heights [Z ~> m] real :: a0 ! The displacement amplitude [Z ~> m]. - real :: weight_z ! A (misused?) depth-space weighting, in inconsistent units. - real :: x1, y1, x2, y2 ! Dimensonless parameters. - real :: x, t ! Dimensionless depth coordinates? + real :: weight_z ! A depth-space weighting [nondim]. + real :: x1, y1, x2, y2 ! Dimensonless parameters specifying the depth profile [nondim] + real :: x, t ! Dimensionless depth coordinates scales [nondim] logical :: use_IC_bug ! If true, set the initial conditions retaining an old bug. ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "sloshing_initialization" !< This module's name. - integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -133,7 +132,7 @@ subroutine sloshing_initialize_thickness ( h, depth_tot, G, GV, US, param_file, x = G%geoLonT(i,j) / G%len_lon if (use_IC_bug) then - displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z + displ(k) = a0 * cos(acos(-1.0)*x) + weight_z * US%m_to_Z ! There is a flag to fix this bug. else displ(k) = a0 * cos(acos(-1.0)*x) * weight_z endif @@ -176,29 +175,28 @@ end subroutine sloshing_initialize_thickness !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_file, just_read) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. - logical, intent(in) :: just_read !< If true, this call will - !! only read parameters without changing T & S. + type(param_file_type), intent(in) :: param_file !< A structure to parse + !! for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing T & S. + ! Local variables + real :: delta_T ! Temperature difference between layers [C ~> degC] + real :: S_ref, T_ref ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within surface layer + real :: S_range, T_range ! Range of salinities [S ~> ppt] and temperatures [C ~> degC] over the vertical + real :: S_surf ! Initial surface salinity [S ~> ppt] + real :: T_pert ! A perturbed temperature [C ~> degC] + integer :: kdelta ! Half the number of layers with the temperature perturbation + real :: deltah ! Thickness of each layer [Z ~> m] + real :: xi0, xi1 ! Fractional vertical positions [nondim] + character(len=40) :: mdl = "sloshing_initialization" ! This module's name. integer :: i, j, k, is, ie, js, je, nz - real :: delta_T - real :: S_ref, T_ref; ! Reference salinity [S ~> ppt] and temperature [C ~> degC] within - ! surface layer - real :: S_range, T_range; ! Range of [S ~> ppt] and temperatures [C ~> degC] over the - ! vertical - integer :: kdelta - real :: deltah - real :: xi0, xi1 - character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's - ! name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -208,10 +206,15 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ units='degC', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) ! The default is to assume an increase by 2 ppt for the salinity and a uniform temperature. - call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range.', & + call get_param(param_file, mdl, "S_RANGE", S_range, 'Initial salinity range.', & units='1e-3', default=2.0, scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & units='degC', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "INITIAL_SSS", S_surf, "Initial surface salinity", & + units="1e-3", default=34.0, scale=US%ppt_to_S, do_not_log=just_read) + call get_param(param_file, mdl, "SLOSHING_T_PERT", T_pert, & + 'A mid-column temperature perturbation in the sloshing test case', & + units='degC', default=1.0, scale=US%degC_to_C, do_not_log=just_read) if (just_read) return ! All run-time parameters have been read, so return. @@ -228,7 +231,7 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ xi0 = 0.0 do k = 1,nz xi1 = xi0 + deltah / G%max_depth ! = xi0 + 1.0 / real(nz) - S(i,j,k) = 34.0*US%ppt_to_S + 0.5 * S_range * (xi0 + xi1) + S(i,j,k) = S_surf + 0.5 * S_range * (xi0 + xi1) xi0 = xi1 enddo enddo ; enddo @@ -241,7 +244,8 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, GV, US, param_ T(:,:,k) = T(:,:,k-1) + delta_T enddo kdelta = 2 - T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = 1.0*US%degC_to_C + ! Perhaps the following lines should instead assign T() = T_pert + T_ref + T(:,:,GV%ke/2 - (kdelta-1):GV%ke/2 + kdelta) = T_pert end subroutine sloshing_initialize_temperature_salinity diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index d25ad0615c..4a20f0e9b3 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -25,7 +25,10 @@ module tidal_bay_initialization !> Control structure for tidal bay open boundaries. type, public :: tidal_bay_OBC_CS ; private - real :: tide_flow = 3.0e6 !< Maximum tidal flux [L2 Z T-1 ~> m3 s-1] + real :: tide_flow = 3.0e6 !< Maximum tidal flux with the tidal bay configuration [L2 Z T-1 ~> m3 s-1] + real :: tide_period !< The period associated with the tidal bay configuration [T ~> s] + real :: tide_ssh_amp !< The magnitude of the sea surface height anomalies at the inflow + !! with the tidal bay configuration [Z ~> m] end type tidal_bay_OBC_CS contains @@ -43,6 +46,13 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) call get_param(param_file, mdl, "TIDAL_BAY_FLOW", CS%tide_flow, & "Maximum total tidal volume flux.", & units="m3 s-1", default=3.0e6, scale=US%m_s_to_L_T*US%m_to_L*US%m_to_Z) + call get_param(param_file, mdl, "TIDAL_BAY_PERIOD", CS%tide_period, & + "Period of the inflow in the tidal bay configuration.", & + units="s", default=12.0*3600.0, scale=US%s_to_T) + call get_param(param_file, mdl, "TIDAL_BAY_SSH_ANOM", CS%tide_ssh_amp, & + "Magnitude of the sea surface height anomalies at the inflow with the "//& + "tidal bay configuration.", & + units="m", default=0.1, scale=US%m_to_Z) ! Register the open boundaries. call register_OBC(casename, param_file, OBC_Reg) @@ -63,11 +73,11 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(time_type), intent(in) :: Time !< model time. ! The following variables are used to set up the transport in the tidal_bay example. - real :: time_sec + real :: time_sec ! Elapsed model time [T ~> s] real :: cff_eta ! The total column thickness anomalies associated with the inflow [H ~> m or kg m-2] real :: my_flux ! The vlume flux through the face [L2 Z T-1 ~> m3 s-1] real :: total_area ! The total face area of the OBCs [L Z ~> m2] - real :: PI + real :: PI ! The ratio of the circumference of a circle to its diameter [nondim] real :: flux_scale ! A scaling factor for the areas [m2 H-1 L-1 ~> nondim or m3 kg-1] real, allocatable :: my_area(:,:) ! The total OBC inflow area [m2] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, n @@ -86,10 +96,10 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) flux_scale = GV%H_to_m*US%L_to_m - time_sec = time_type_to_real(Time) - cff_eta = 0.1*GV%m_to_H * sin(2.0*PI*time_sec/(12.0*3600.0)) - my_area=0.0 - my_flux=0.0 + time_sec = US%s_to_T*time_type_to_real(Time) + cff_eta = CS%tide_ssh_amp*GV%Z_to_H * sin(2.0*PI*time_sec / CS%tide_period) + my_area = 0.0 + my_flux = 0.0 segment => OBC%segment(1) do j=segment%HI%jsc,segment%HI%jec ; do I=segment%HI%IscB,segment%HI%IecB @@ -101,7 +111,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) endif enddo ; enddo total_area = reproducing_sum(my_area) - my_flux = - CS%tide_flow*SIN(2.0*PI*time_sec/(12.0*3600.0)) + my_flux = - CS%tide_flow * SIN(2.0*PI*time_sec / CS%tide_period) do n = 1, OBC%number_of_segments segment => OBC%segment(n) diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 762cee5446..c12d34a721 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -7,7 +7,7 @@ module user_change_diffusivity use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, EOS_domain @@ -29,7 +29,7 @@ module user_change_diffusivity real :: Kd_add !< The scale of a diffusivity that is added everywhere !! without any filtering or scaling [Z2 T-1 ~> m2 s-1]. real :: lat_range(4) !< 4 values that define the latitude range over which - !! a diffusivity scaled by Kd_add is added [degLat]. + !! a diffusivity scaled by Kd_add is added [degrees_N]. real :: rho_range(4) !< 4 values that define the coordinate potential !! density range over which a diffusivity scaled by !! Kd_add is added [R ~> kg m-3]. @@ -151,7 +151,7 @@ end subroutine user_change_diff !> This subroutine checks whether the 4 values of range are in ascending order. function range_OK(range) result(OK) - real, dimension(4), intent(in) :: range !< Four values to check. + real, dimension(4), intent(in) :: range !< Four values to check [arbitrary] logical :: OK !< Return value. OK = ((range(1) <= range(2)) .and. (range(2) <= range(3)) .and. & @@ -169,7 +169,7 @@ function val_weights(val, range) result(ans) real, dimension(4), intent(in) :: range !< Range over which the answer is non-zero [arbitrary units]. real :: ans !< Return value [nondim]. ! Local variables - real :: x ! A nondimensional number between 0 and 1. + real :: x ! A nondimensional number between 0 and 1 [nondim]. ans = 0.0 if ((val > range(1)) .and. (val < range(4))) then @@ -230,7 +230,7 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) "applied. The four values specify the latitudes at "//& "which the extra diffusivity starts to increase from 0, "//& "hits its full value, starts to decrease again, and is "//& - "back to 0.", units="degree", default=-1.0e9) + "back to 0.", units="degrees_N", default=-1.0e9) call get_param(param_file, mdl, "USER_KD_ADD_RHO_RANGE", CS%rho_range(:), & "Four successive values that define a range of potential "//& "densities over which the user-given extra diffusivity "//& diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index eb9694a091..ce767d7479 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -21,7 +21,7 @@ module user_revise_forcing !> Control structure for user_revise_forcing type, public :: user_revise_forcing_CS ; private - real :: cdrag !< The quadratic bottom drag coefficient. + real :: cdrag !< The quadratic bottom drag coefficient [nondim] end type user_revise_forcing_CS contains